ppchrtdp.pas

pasa人力资源考勤管理系统

{******************************************************************************}
{                                                                              }
{                   ReportBuilder Report Component Library                     }
{                                                                              }
{             Copyright (c) 1996, 2000 Digital Metaphors Corporation           }
{                                                                              }
{******************************************************************************}

unit ppChrtDP;

interface

{$I ppIfDef.pas}

uses
  SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls,
  TeeProcs, TeEngine, Chart,
  {$IFDEF Tee50}
    TeeEditCha, TeeEdiSeri, ppChDPEdDlg,
  {$ELSE}
    IEditCha, ppChDPEd,
  {$ENDIF}
  ppComm, ppClass, ppDevice, ppTypes, ppDB, ppChrt, ppDsgnCt, ppDrwCmd;

type

  TppCustomDBChart = class;

  { TppCustomDBChart }
  TppCustomDBChart = class(TCustomChart)
    private
      FAutoRefresh: Boolean;
      FDataPipeList: TList;
      FShowGlassCursor: Boolean;
      FRefreshingData: Boolean;

      procedure AddPointToSeries(aDataPipeline: TppDataPipeline; aSeries: TChartSeries; aX, aY: Double; aXLabel: String; aColor: TColor);
      function  GetFloatFieldValue(aDataPipeline: TppDataPipeline; const aFieldAlias: String): Double;
      procedure GetSeriesForDataPipeline(aDataPipeline: TppDataPipeline; aSeriesList: TChartSeriesList);
      procedure RecordToPoint(aDataPipeline: TppDataPipeline; aSeries: TChartSeries);
      procedure TraverseDataPipeline(aDataPipeline: TppDataPipeline; aSeriesList: TChartSeriesList);

    public
      constructor Create(aOwner: TComponent); override;
      destructor Destroy; override;

      procedure Assign(Source: TPersistent); override;
      function  IsValidDataSource(aSeries: TChartSeries; aComponent: TComponent): Boolean; override;

      procedure FillSeriesSourceItems(aSeries: TChartSeries; Proc: TGetStrProc); override;
      procedure FillValueSourceItems(aValueList: TChartValueList; Proc: TGetStrProc); override;
      procedure RefreshData;
      procedure RefreshDataPipeline(aDataPipeline: TppDataPipeline);

      property DataPipeList: TList read FDataPipeList write FDataPipeList;

      property AutoRefresh: Boolean read FAutoRefresh write FAutoRefresh default True;
      property ShowGlassCursor: Boolean read FShowGlassCursor write FShowGlassCursor default True;

      property RefreshingData: Boolean read FRefreshingData;

    end; {class, TppCustomDBChart}

  { TppDPTeeChart }
  TppDPTeeChart = class(TppCustomTeeChart)
    private
      FDataPipeList: TList;

      procedure UpdateDataPipeList;
      
      {popup menu event handlers}
      procedure RefreshDataMenuClick(Sender: TObject);

    protected
      procedure CreateChart(var aChart: TCustomChart); override;
      procedure CreatePopupMenu(aOwner: TComponent; var aPopupMenu: TppPopupMenu); override;
      procedure PropertiesToDrawCommand(aDrawCommand: TppDrawCommand); override;

    public
      constructor Create(aOwner: TComponent); override;
      destructor Destroy; override;

      procedure Edit; override;
      procedure GetDataPipelines(aDataPipelines: TList); override;
      procedure PopupMenuClick(Sender: TObject); override;
      procedure PaintDesignControl(aCanvas: TCanvas); override;

      procedure Loaded; override;

      procedure Notify(aCommunicator: TppCommunicator; aOperation: TppOperationType); override;

    published
      property Chart;
      property PrintMethod;
      property Visible;

      {these properties saved in 'fake' properties}
      property Height stored False;
      property Left stored False;
      property Top stored False;
      property Width stored False;
  end; {class, TppDPTeeChart}


  { TppDPTeeChartControl }
  TppDPTeeChartControl = class(TppCustomDBChart)
    private
      FStreamingParent: TComponent;

      procedure SetStreamingParent(aParent: TComponent);

    protected

      procedure SetParentComponent(Value: TComponent); override;
      procedure ReadState(Reader: TReader); override;

    public
      constructor Create(aOwner: TComponent); override;
      destructor Destroy; override;

      function  HasParent: Boolean; override;
      function  GetParentComponent: TComponent; override;

      property StreamingParent: TComponent read FStreamingParent write SetStreamingParent;

    published
      { TCustomDBChart properties }
      property ShowGlassCursor;

      { TCustomChart Properties }
      property BackImage;
      property BackImageInside;
      property BackImageMode;
      property BottomWall;
      property Foot;
      property Gradient;
      property LeftWall;
      property MarginBottom;
      property MarginLeft;
      property MarginRight;
      property MarginTop;
      property Title;

      { TCustomAxisPanel properties }
      property AxisVisible;
      property BackColor;
      property BottomAxis;
      property Chart3DPercent;
      property ClipPoints;
      property Frame;
      property LeftAxis;
      property Legend;
      property MaxPointsPerPage;
      property Page;
      property RightAxis;
      property ScaleLastPage;
      property SeriesList;
      property TopAxis;
      property View3D;
      property View3DWalls;

      { TPanel properties }
      property BevelInner;
      property BevelWidth;
      property BevelOuter;
      property BorderWidth;
      property BorderStyle;
      property Color;

  end; {class, TppDPTeeChartControl}

implementation

uses TeeConst;

{******************************************************************************
 *
 ** C U S T O M   D B   C H A R T
 *
{******************************************************************************}

{------------------------------------------------------------------------------}
{ TppCustomDBChart.Create }

constructor TppCustomDBChart.Create(aOwner: TComponent);
begin

  inherited Create(aOwner);

  FAutoRefresh := True;
  FDataPipeList := nil;
  FShowGlassCursor := True;
  FRefreshingData := False;

end; {constructor, Create}

{------------------------------------------------------------------------------}
{ TppCustomDBChart.Destroy }

destructor TppCustomDBChart.Destroy;
begin

  inherited Destroy;

end; {destructor, Destroy}

{------------------------------------------------------------------------------}
{ TppCustomDBChart.Assign }

procedure TppCustomDBChart.Assign(Source: TPersistent);
var
  lSource: TppCustomDBChart;
begin

  inherited Assign(Source);

  if not(Source is TppCustomDBChart) then Exit;

  lSource := TppCustomDBChart(Source);

  AutoRefresh := lSource.AutoRefresh;
  ShowGlassCursor := lSource.ShowGlassCursor;

end; {procedure, Assign}

{------------------------------------------------------------------------------}
{ TppCustomDBChart.IsValidDataSource }

function TppCustomDBChart.IsValidDataSource(aSeries: TChartSeries; aComponent: TComponent):Boolean;
begin
  Result := ((ASeries <> AComponent) and
            ((aComponent is TChartSeries) and aSeries.IsValidSeriesSource(TChartSeries(aComponent))) or
             (aComponent is TppDataPipeline) and (TppDataPipeline(aComponent).Visible));

end; {procedure, IsValidDataSource}

{------------------------------------------------------------------------------}
{ TppCustomDBChart.FillSeriesSourceItems }

procedure TppCustomDBChart.FillSeriesSourceItems(aSeries: TChartSeries; Proc: TGetStrProc);
var
  liIndex: Integer;
  lDataPipeline: TppDataPipeline;
begin

  if (aSeries.DataSource = nil) or not(aSeries.DataSource is TppDataPipeline) then Exit;

  lDataPipeline := TppDataPipeline(aSeries.DataSource);

  for liIndex := 0 to lDataPipeline.FieldCount - 1 do
    Proc(lDataPipeline.Fields[liIndex].FieldAlias);

end; {procedure, FillSeriesSourceItems}

{------------------------------------------------------------------------------}
{ TppCustomDBChart.FillValueSourceItems }

procedure TppCustomDBChart.FillValueSourceItems(aValueList: TChartValueList; Proc: TGetStrProc);
var
  lSeries: TChartSeries;
begin

  lSeries := aValueList.Owner;

  if (lSeries.DataSource = nil) and (lSeries.DataSource is TppDataPipeline) then
    FillSeriesSourceItems(lSeries, Proc)
  else
    inherited FillValueSourceItems(aValueList, Proc);

end; {procedure, FillValueSourceItems}

{------------------------------------------------------------------------------}
{ TppCustomDBChart.RefreshData }

procedure TppCustomDBChart.RefreshData;
var
  liIndex: Integer;
  lDataPipeline: TppDataPipeline;
begin

  if FRefreshingData then Exit;

  if (FDataPipeList = nil) then Exit;

  for liIndex := 0 to FDataPipeList.Count - 1 do
    begin
      lDataPipeline := TppDataPipeline(FDataPipeList[liIndex]);

      RefreshDataPipeline(lDataPipeline)
    end;

end; {procedure, RefreshData}

{------------------------------------------------------------------------------}
{ TppCustomDBChart.GetFloatFieldValue }

function TppCustomDBChart.GetFloatFieldValue(aDataPipeline: TppDataPipeline; const aFieldAlias: String): Double;
var
  lField: TppField;
begin
  lField := aDataPipeline.GetFieldForAlias(aFieldAlias);


  if (lField = nil) or (aDataPipeline.GetFieldIsNull(lField.FieldName)) then
    Result := 0
  else
    Result := lField.Value;

end; {procedure, GetFloatFieldValue}


{$IFDEF Tee50}

{------------------------------------------------------------------------------}
{ TppCustomDBChart.AddPointToSeries }

procedure TppCustomDBChart.AddPointToSeries(aDataPipeline: TppDataPipeline; aSeries: TChartSeries; aX, aY: Double; aXLabel: String; aColor: TColor);
var
  liIndex: Integer;
  lValueList: TChartValueList;
begin

  for liIndex := 2 to aSeries.ValuesList.Count - 1 do
    begin
      lValueList := aSeries.ValuesList[liIndex];

      if (lValueList.ValueSource <> '') then
        lValueList.TempValue := GetFloatFieldValue(aDataPipeline, lValueList.ValueSource)
      else
        lValueList.TempValue := 0;

    end;

    if aSeries.NotMandatoryValueList.ValueSource = '' then
      begin
        if aSeries.YMandatory then
          aSeries.AddY(aY, aXLabel, aColor)
        else
          aSeries.AddX(aX, aXLabel, aColor)
      end
    else
      aSeries.AddXY(aX, aY, aXLabel, aColor);

end; {procedure, AddPointToSeries}


{$ELSE}

{------------------------------------------------------------------------------}
{ TppCustomDBChart.AddPointToSeries }

procedure TppCustomDBChart.AddPointToSeries(aDataPipeline: TppDataPipeline; aSeries: TChartSeries; aX, aY: Double; aXLabel: String; aColor: TColor);
var
  liIndex: Integer;
  lValueList: TChartValueList;
begin

  for liIndex := 2 to aSeries.ValuesLists.Count - 1 do
    begin
      lValueList := aSeries.ValuesLists[liIndex];

      if (lValueList.ValueSource <> '') then
        lValueList.TempValue := GetFloatFieldValue(aDataPipeline, lValueList.ValueSource)
      else
        aSeries.ClearTempValue(lValueList);

    end;

  if aSeries.YMandatory then
    begin
      if (aSeries.XValues.ValueSource <> '') then
        liIndex := aSeries.AddXY(aX, aY, aXLabel, aColor)
      else
        liIndex := aSeries.AddY(aY, aXLabel, aColor);
    end
  else
    begin
      if (aSeries.YValues.ValueSource <> '') then
        liIndex := aSeries.AddXY(aX, aY, aXLabel, aColor)
      else
        liIndex := aSeries.AddX(aX, aXLabel, aColor);
    end;

  if (liIndex <> -1) then
    aSeries.AddValue(liIndex);

end; {procedure, AddPointToSeries}

{$ENDIF}

{------------------------------------------------------------------------------}
{ TppCustomDBChart.RecordToPoint }

procedure TppCustomDBChart.RecordToPoint(aDataPipeline: TppDataPipeline; aSeries: TChartSeries);
var
  liIndex: Integer;
  liFieldCount: Integer;
  lsFieldAlias: String;
  lField: TppField;
  lsXLabel: String;
  lColor: TColor;
  ldX: Double;
  ldY: Double;
begin

  ldX := 0;
  ldY := 0;
  lColor := clTeeColor;

  {get the x-label}
  if (aSeries.XLabelsSource <> '') then
    begin
      lsFieldAlias := aSeries.XLabelsSource;
      lField := aDataPipeline.GetFieldForAlias(lsFieldAlias);
      lsXLabel := aDataPipeline.GetFieldAsString(lField.FieldName);
    end
  else
    lsXLabel := '';

  {get the color}
  if (aSeries.ColorSource = '') then
    begin
      lsFieldAlias := TeeExtractField(aSeries.MandatoryValueList.ValueSource, 1);

      lField := aDataPipeline.GetFieldForAlias(lsFieldAlias);

      if (lField <> nil) and (aDataPipeline.GetFieldIsNull(lField.FieldName)) then
        lColor := clNone
      else
        lColor := clTeeColor;
    end
  else
    begin
      lsFieldAlias := aSeries.ColorSource;

      lField := aDataPipeline.GetFieldForAlias(lsFieldAlias);

      if (lField <> nil) then
        lColor := aDataPipeline.GetFieldValue(lField.FieldName);
    end;

  liFieldCount := TeeNumFields(aSeries.MandatoryValueList.ValueSource);

  if (liFieldCount = 1) then
    begin
      lsFieldAlias := aSeries.MandatoryValueList.ValueSource;

      {if aSeries.XLabelsSource = '' then
          lsXLabel := lsFieldAlias;}

      if aSeries.YMandatory then
        begin
          ldX := GetFloatFieldValue(aDataPipeline, aSeries.XValues.ValueSource);
          ldY := GetFloatFieldValue(aDataPipeline, lsFieldAlias);
        end
      else
        begin
          ldX := GetFloatFieldValue(aDataPipeline, lsFieldAlias);
          ldY := GetFloatFieldValue(aDataPipeline, aSeries.YValues.ValueSource);
        end;

      AddPointToSeries(aDataPipeline, aSeries, ldX, ldY, lsXLabel, lColor);
    end

  else
    for liIndex := 1 to liFieldCount do
      begin
        lsFieldAlias := TeeExtractField(aSeries.MandatoryValueList.ValueSource, liIndex);

        {if aSeries.XLabelsSource = '' then
          lsXLabel := lsFieldAlias;}

        if aSeries.YMandatory then
          ldY := GetFloatFieldValue(aDataPipeline, lsFieldAlias)
        else
          ldX := GetFloatFieldValue(aDataPipeline, lsFieldAlias);

        AddPointToSeries(aDataPipeline, aSeries, ldX, ldY, lsXLabel, lColor);
      end;

end; {procedure, RecordToPoint}

{------------------------------------------------------------------------------}
{ TppCustomDBChart.TraverseDataPipeline }

procedure TppCustomDBChart.TraverseDataPipeline(aDataPipeline: TppDataPipeline; aSeriesList: TChartSeriesList);
var
  lBookmark: Integer;
  liIndex: Integer;
  lDPState: TppDataPipelineStates;
  liTraversalCount: Integer;
  liRecordNo: Integer;
begin

  lBookmark := 0;
  liTraversalCount := 0;
  liRecordNo := 0;

  try
    lDPState := aDataPipeline.State;
    liTraversalCount := aDataPipeline.TraversalCount;
    liRecordNo := aDataPipeline.RecordNo;
    lBookmark := aDataPipeline.GetBookMark;

    aDataPipeline.First;

    while not(aDataPipeline.EOF) do
      try

        for liIndex := 0 to aSeriesList.Count - 1 do
          RecordToPoint(aDataPipeline, aSeriesList[liIndex]);

        aDataPipeline.Next;
      except
        on EAbort do Break; { <-- exit while loop !!! }
      end; {try-except, next record}

  finally
    try
      aDataPipeline.GotoBookMark(lBookmark);
    finally
      aDataPipeline.FreeBookMark(lBookmark);
    end;

    aDataPipeline.State := lDPState;
    aDataPipeline.TraversalCount := liTraversalCount;
    aDataPipeline.RecordNo := liRecordNo;

  end; {try-finally, bookmark}

end; {procedure, TraverseDataPipeline}