teeorgseries.pas

BCB第三方组件

{**********************************************}
{   TOrgSeries Organizational Charts           }
{   Copyright (c) 2007 by Steema Software      }
{**********************************************}
unit TeeOrgSeries;
{$I TeeDefs.inc}

interface

uses
  {$IFNDEF LINUX}
  Windows,
  {$ENDIF}
  Classes, SysUtils, Math,
  {$IFDEF CLX}
  QStdCtrls, QControls, QButtons, QExtCtrls, QComCtrls, QForms,
  {$ELSE}
  StdCtrls, Controls, Buttons, ExtCtrls, ComCtrls, Forms,
  {$ENDIF}
  TeCanvas, TeEngine, Chart, TeeTools, TeeConst, TeePenDlg, TeeComma, TeeProcs,
  TeeCustomShapeEditor, TeeStringsEditor, TeeMargins;

type
  TOrgSeries=class;  // forward

  TOrgShape=class(TTextShape)
  published
    property CustomPosition default True;
    property Left stored False;
    property Top stored False;
    property TextAlignment default taCenter;
  end;

  TOrgItem=class(TCollectionItem)
  private
    FFormat : TOrgShape;

    function GetSuperior: Integer;
    function GetText: String;
    procedure SetFormat(const Value: TOrgShape);
    procedure SetSuperior(const Value: Integer);
    procedure SetText(const Value: String);
  public
    Constructor Create(Collection: TCollection); override;
    Destructor Destroy; override;

    function AddChild(const Text:String):TOrgItem;
    function AddBrother(const Text:String):TOrgItem;
    procedure Assign(Source:TPersistent); override;
    function Series:TOrgSeries;

    property Superior:Integer read GetSuperior write SetSuperior stored False;
    property Text:String read GetText write SetText stored False;
  published
    property Format:TOrgShape read FFormat write SetFormat;
  end;

  TOrgItemCollection=class(TOwnedCollection)
  private
    Function Get(Index:Integer):TOrgItem;
    Procedure Put(Index:Integer; Const Value:TOrgItem);
  public
    property Items[Index:Integer]:TOrgItem read Get write Put; default;
  end;

  TSpacing=class(TPersistent)
  private
    FVert: Integer;
    FHoriz: Integer;

    ISeries : TChartSeries;

    procedure SetHoriz(const Value: Integer);
    procedure SetVert(const Value: Integer);
  public
    Constructor Create;
    procedure Assign(Source:TPersistent); override;
  published
    property Horizontal:Integer read FHoriz write SetHoriz default 8;
    property Vertical:Integer read FVert write SetVert default 16;
  end;

  TOrgLineStyle=(lsSquared,lsDiagonal);

  TOrgSeries=class(TChartSeries)
  private
    FDefault   : TOrgShape;
    FLineStyle : TOrgLineStyle;
    FNodes     : TOrgItemCollection;
    FSpacing   : TSpacing;

    IBounds    : TRect;
    procedure GetChilds(List:TList; Superior:Integer; VisibleOnly:Boolean);
    function GetItem(Index: Integer): TOrgItem;
    procedure SetDefault(const Value: TOrgShape);
    procedure SetItem(Index: Integer; const Value: TOrgItem);
    procedure SetLineStyle(const Value: TOrgLineStyle);
    procedure SetNodes(const Value: TOrgItemCollection);
    procedure SetSpacing(const Value: TSpacing);
  protected
    Procedure AddSampleValues(NumValues:Integer; OnlyMandatory:Boolean=False); override;
    procedure ClearLists; override;
    procedure DrawAllValues; override;
    class Function GetEditorClass:String; override;
    procedure Loaded; override;
    procedure SetParentChart(const Value: TCustomAxisPanel); override;
  public
    Constructor Create(AOwner:TComponent); override;
    Destructor Destroy; override;

    function Add(const Text:String; Superior:Integer=-1):Integer; overload;
    procedure Assign(Source:TPersistent); override;
    Function CalcXPos(ValueIndex:Integer):Integer; override;
    Function CalcYPos(ValueIndex:Integer):Integer; override;
    Function Clicked(x,y:Integer):Integer; override;
    procedure Delete(ValueIndex:Integer); override;
    function FirstChild(ValueIndex:Integer):Integer;
    Function IsValidSourceOf(Value:TChartSeries):Boolean; override;
    procedure SwapValueIndex(a,b:Integer); override;
    Function UseAxis:Boolean; override;

    property Bounds:TRect read IBounds;
    property Item[Index:Integer]:TOrgItem read GetItem write SetItem; default;
  published
    { Published declarations }
    property Active;
    property ColorSource;
    property Cursor;
    property HorizAxis;
    property Marks;
    property ParentChart;
    property DataSource;
    property PercentFormat;
    property SeriesColor;
    property ShowInLegend default False;
    property Title;
    property ValueFormat;
    property VertAxis;
    property XLabelsSource;

    property Brush;
    property Pen;

    property Format:TOrgShape read FDefault write SetDefault;
    property Items:TOrgItemCollection read FNodes write SetNodes;
    property LineStyle:TOrgLineStyle read FLineStyle write SetLineStyle default lsSquared;
    property Spacing:TSpacing read FSpacing write SetSpacing;

    property XValues;
    property YValues;

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

  TOrgSeriesEditor = class(TForm)
    PageControl2: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    GroupBox1: TGroupBox;
    ScrollBar1: TScrollBar;
    ScrollBar2: TScrollBar;
    ButtonPen1: TButtonPen;
    Panel3: TPanel;
    LBNodes: TListBox;
    PageControl1: TPageControl;
    TabText: TTabSheet;
    Label3: TLabel;
    Label1: TLabel;
    Label9: TLabel;
    Memo1: TMemo;
    ComboFlat1: TComboFlat;
    CBCursor: TComboFlat;
    Button1: TButton;
    Splitter1: TSplitter;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    TabSheet3: TTabSheet;
    CBAutoSize: TCheckBox;
    Label14: TLabel;
    Label15: TLabel;
    ECustWidth: TEdit;
    ECustHeight: TEdit;
    UDWidth: TUpDown;
    UDHeight: TUpDown;
    CBClip: TCheckBox;
    CBVisible: TCheckBox;
    Label2: TLabel;
    CBLineStyle: TComboFlat;
    Label4: TLabel;
    Label5: TLabel;
    TabMargins: TTabSheet;
    procedure FormCreate(Sender: TObject);
    procedure ScrollBar1Change(Sender: TObject);
    procedure ScrollBar2Change(Sender: TObject);
    procedure Memo1Change(Sender: TObject);
    procedure ComboFlat1Change(Sender: TObject);
    procedure CBCursorChange(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure LBNodesClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure ECustWidthChange(Sender: TObject);
    procedure ECustHeightChange(Sender: TObject);
    procedure CBAutoSizeClick(Sender: TObject);
    procedure CBClipClick(Sender: TObject);
    procedure CBVisibleClick(Sender: TObject);
    procedure CBLineStyleChange(Sender: TObject);
    procedure PageControl2Change(Sender: TObject);
  private
    { Private declarations }
    Series      : TOrgSeries;
    NodeEditor  : TFormTeeShape;
    MarginsForm : TMarginsEditor;
    IChanging   : Boolean;

    procedure AddListNodes(Series:TOrgSeries; Current:Integer);
    function CurrentIndex:Integer;
    function CurrentItem:TOrgItem;
    procedure SetupEditor(ASeries:TOrgSeries);
  public
    { Public declarations }
    procedure RefreshNode(Index:Integer);
  end;

implementation

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

uses
  TeeLegendScrollBar, TeeProCo;

type
  TPanelScrollBar=class(TTeeScrollBar)
  private
  protected
    function CurrentCount:Integer; override;
    function DeltaMain: Integer; override;
    function GetPosition:Integer; override;
    procedure SetParentChart(const Value: TCustomAxisPanel); override;
    procedure SetPosition(Value:Integer); override;
    function ShouldDraw(var R:TRect):Boolean; override;
    function TotalCount:Integer; override;
  public
    Destructor Destroy; override;
    class Function Description:String; override;
    class Function LongDescription:String; override;
  end;

{
var h, v : TPanelScrollBar;

  v:=TPanelScrollBar.Create(Self);
  v.ParentChart:=Chart1;
  v.Horizontal:=False;

  h:=TPanelScrollBar.Create(Self);
  h.ParentChart:=Chart1;
  h.Horizontal:=True;
}

{ TPanelScrollBar }
function TPanelScrollBar.CurrentCount: Integer;
begin
  if Horizontal then
     result:=ParentChart.ChartWidth
  else
     result:=ParentChart.ChartHeight;
end;

function TPanelScrollBar.DeltaMain: Integer;
begin
  result:=0;
end;

class function TPanelScrollBar.Description: String;
begin
  result:='ScrollBar';
end;

Destructor TPanelScrollBar.Destroy;
begin
  inherited;
end;

function TPanelScrollBar.GetPosition: Integer;
begin
  if Horizontal then
     result:=ParentChart.View3DOptions.HorizOffset
  else
     result:=ParentChart.View3DOptions.VertOffset;
end;

class function TPanelScrollBar.LongDescription: String;
begin
  result:='ScrollBar';
end;

procedure TPanelScrollBar.SetParentChart(const Value: TCustomAxisPanel);
begin
  inherited;
end;

procedure TPanelScrollBar.SetPosition(Value: Integer);
begin
  if Horizontal then
     ParentChart.View3DOptions.HorizOffset:=Value
  else
     ParentChart.View3DOptions.VertOffset:=Value;

  inherited;
end;

function TPanelScrollBar.ShouldDraw(var R: TRect): Boolean;
begin
  R:=ParentChart.ChartBounds;

  if Horizontal then
  begin
    Dec(R.Bottom, Size);
    Dec(R.Right, Size);
  end
  else
  begin
    Dec(R.Bottom, Size-1);
  end;

  result:=True;
end;

function TPanelScrollBar.TotalCount: Integer;
begin
  result:=CurrentCount+10;
end;

{ TOrgSeries }
Constructor TOrgSeries.Create(AOwner: TComponent);
begin
  inherited;

  CalcVisiblePoints:=False;

  FNodes:=TOrgItemCollection.Create(Self,TOrgItem);

  FDefault:=TOrgShape.Create(nil);
  FDefault.TextAlignment:=taCenter;

  FSpacing:=TSpacing.Create;
  FSpacing.ISeries:=Self;

  Pen.EndStyle:=esSquare;
  ShowInLegend:=False;

  if (csDesigning in ComponentState) and
     (not (csLoading in ComponentState)) then
          FillSampleValues;

  ManualData:=True;
end;

Destructor TOrgSeries.Destroy;
begin
  FreeAndNil(FDefault);
  FreeAndNil(FNodes);
  FSpacing.Free;
  inherited;
end;

function TOrgSeries.Add(const Text:String; Superior:Integer=-1):Integer;
var tmp : TOrgShape;
begin
  result:=inherited Add(Superior,Text);

  tmp:=TOrgItem(FNodes.Add).FFormat;
  tmp.Assign(FDefault);
  tmp.Text:=Text;
end;

procedure TOrgSeries.Assign(Source: TPersistent);
begin
  // Important: Call inherited before anything else, to avoid losing the nodes.
  inherited;

  if Source is TOrgSeries then
  with TOrgSeries(Source) do
  begin
    Self.FNodes.Assign(FNodes);
    Self.FLineStyle:=FLineStyle;
    Self.FSpacing.FVert:=FSpacing.FVert;
    Self.FSpacing.FHoriz:=FSpacing.FHoriz;
  end;
end;

procedure TOrgSeries.GetChilds(List:TList; Superior:Integer; VisibleOnly:Boolean);
var t : Integer;
begin
  List.Clear;

  for t:=0 to Min(FNodes.Count,Count)-1 do
  if (MandatoryValueList.Value[t]=Superior) and
     ((not VisibleOnly) or FNodes[t].FFormat.Visible) then
           List.Add({$IFDEF CLR}TObject{$ELSE}Pointer{$ENDIF}(t));
end;

{$IFNDEF CLR}
type
  TFormatAccess=class(TTextShape);
{$ENDIF}

procedure TOrgSeries.DrawAllValues;

  procedure DrawNodes(Parent,XPos,YPos:Integer);

    procedure DrawChilds(List:TList; XPos,YPos:Integer);

      function GetTreeWidth(List:TList):Integer;
      var t : Integer;
          tmp : Integer;
          IFormat : TTextShape;
          //List2 : TList;
      begin
        result:=Spacing.Horizontal*(List.Count-1);

        tmp:=0;

        for t:=0 to List.Count-1 do
        begin
          IFormat:=TOrgItem(FNodes.Items[Integer(List[t])]).FFormat;

          {
          GetChilds(List2,Integer(List[t]));
          tmp:=Max(tmp,GetTreeWidth(List2));
          }
          with IFormat.ShapeBounds do
               Inc(result,Max(Right-Left+1,tmp));
        end;
      end;

      function ChildCount(Index:Integer):Integer;
      var t : Integer;
      begin
        result:=0;

        for t:=0 to Count-1 do
            if MandatoryValueList.Value[t]=Index then
               Inc(result);
      end;

    var tmpR : TRect;
        maxH,
        maxW,
        tmpLeft,
        tmp,
        tmpX0,
        tmpX1,
        tmpY,
        tmpSup,
        tmpX,
        t : Integer;
        IFormat : TTextShape;
        tmpRoots : TList;
    begin
      // Calc total width
      maxW:=GetTreeWidth(List);

      IBounds.Top:=Min(IBounds.Top,YPos);

      for t:=0 to List.Count-1 do
      begin
        IFormat:=TOrgItem(FNodes.Items[Integer(List[t])]).FFormat;
        tmp:=IFormat.Height;
        IFormat.Top:=YPos+ParentChart.View3DOptions.VertOffset;
        IFormat.Height:=tmp;
      end;

      tmpLeft:=XPos-(maxW div 2)+ParentChart.View3DOptions.HorizOffset;

      IBounds.Left:=Min(IBounds.Left,tmpLeft);

      maxH:=0;

      tmpX0:=0;
      tmpX1:=0;

      tmpY:=0;

      for t:=0 to List.Count-1 do
      begin
        IFormat:=TOrgItem(FNodes.Items[Integer(List[t])]).FFormat;

        tmp:=IFormat.Width;
        IFormat.Left:=tmpLeft;
        IFormat.Width:=tmp;

        tmpR:=IFormat.ShapeBounds;

        if t=0 then
           tmpX0:=tmpLeft+((tmpR.Right-tmpR.Left) div 2)
        else
        if t=List.Count-1 then
           tmpX1:=tmpLeft+((tmpR.Right-tmpR.Left) div 2);

        tmpSup:=Round(MandatoryValueList.Value[Integer(List[t])]);

        if tmpSup<>-1 then
        begin
          ParentChart.Canvas.AssignVisiblePen(Pen);

          if LineStyle=lsSquared then
          begin
            if ChildCount(tmpSup)=1 then
               tmpY:=CalcYPos(tmpSup)
            else
               tmpY:=IFormat.Top-(Spacing.Vertical div 2);

            ParentChart.Canvas.DoVertLine(tmpLeft+((tmpR.Right-tmpR.Left) div 2),
                                           tmpY,IFormat.Top)
          end
          else
          begin
            if ChildCount(tmpSup)=1 then
               tmpX:=CalcXPos(tmpSup)
            else
               tmpX:=tmpLeft+((tmpR.Right-tmpR.Left) div 2);

            ParentChart.Canvas.Line(tmpX,IFormat.Top,CalcXPos(tmpSup),CalcYPos(tmpSup));
          end;
        end;

        {$IFNDEF CLR}TFormatAccess{$ENDIF}(IFormat).DrawText(ParentChart,IFormat.ShapeBounds,0,
                      {$IFNDEF CLR}TFormatAccess{$ENDIF}(IFormat).INumLines);

        maxH:=Math.Max(maxH,tmpR.Bottom-tmpR.Top+1);

        Inc(tmpLeft,tmpR.Right-tmpR.Left+1);

        if t<List.Count-1 then
           Inc(tmpLeft,Spacing.Horizontal)
        else
        with IFormat.Shadow do
        if Visible and (HorizSize>0) then
           Inc(tmpLeft,HorizSize);

        with IFormat.Shadow do
        if Visible and (VertSize>0) then
           IBounds.Bottom:=Max(IBounds.Bottom,tmpR.Bottom+VertSize)
        else
           IBounds.Bottom:=Max(IBounds.Bottom,tmpR.Bottom);
      end;

      IBounds.Right:=Max(IBounds.Right,tmpLeft);

      if LineStyle=lsSquared then
        if List.Count>1 then
        begin
          ParentChart.Canvas.AssignVisiblePen(Pen);
          ParentChart.Canvas.DoHorizLine(tmpX0,tmpX1,tmpY);
        end;

      for t:=0 to List.Count-1 do
      begin
        IFormat:=TOrgItem(FNodes.Items[Integer(List[t])]).FFormat;

        with IFormat.ShapeBounds do
             XPos:=(Left+Right) div 2;

        tmpRoots:=TList.Create;
        try
          GetChilds(tmpRoots,Integer(List[t]),True);

          if tmpRoots.Count>0 then
          begin
            if tmpRoots.Count>1 then
            if LineStyle=lsSquared then
            begin
              ParentChart.Canvas.AssignVisiblePen(Pen);
              tmpY:=IFormat.ShapeBounds.Bottom;