dbchart.pas

TeeChart7Source 控件

  ITimer.Free;
  IDataSources.Free;
  inherited;
end;

// When "AComponent" source is removed from ASeries DataSourceList,
// this method also removes AComponent from internal IDataSources list.
procedure TCustomDBChart.RemovedDataSource( ASeries: TChartSeries;
                                            AComponent: TComponent );
var t   : Integer;
    tmp : TDataSet;
begin
  inherited;

  if AComponent is TDataSet then
  for t:=0 to IDataSources.Count-1 do
  begin
    tmp:=IDataSources[t].DataSet;
    if (not Assigned(tmp)) or (tmp=AComponent) then
    begin
      IDataSources[t].Free;
      IDataSources.Delete(t);
      break;
    end;
  end;
end;

Procedure TCustomDBChart.CheckTimer;
Begin
  if Assigned(ITimer) then ITimer.Enabled:=False;
  if (FRefreshInterval>0) and (not (csDesigning in ComponentState) ) then
  Begin
    if not Assigned(ITimer) then
    Begin
      ITimer:=TTimer.Create(Self);
      ITimer.Enabled:=False;
      ITimer.OnTimer:=OnRefreshTimer;
    end;
    ITimer.Interval:=FRefreshInterval*1000;
    ITimer.Enabled:=True;
  end;
End;

Procedure TCustomDBChart.OnRefreshTimer(Sender:TObject);
var t : Integer;
Begin
  ITimer.Enabled:=False;  { no try..finally here ! }
  for t:=0 to IDataSources.Count-1 do
  With IDataSources[t] do
  if DataSet.Active then
  Begin
    DataSet.Refresh;
    CheckDataSet(DataSet);
  end;
  ITimer.Enabled:=True;
end;

Procedure TCustomDBChart.SetRefreshInterval(Value:Integer);
Begin
  if (Value<0) or (Value>60) then
     Raise DBChartException.Create(TeeMsg_RefreshInterval);
  FRefreshInterval:=Value;
  CheckTimer;
End;

Function TCustomDBChart.IsValidDataSource(ASeries:TChartSeries; AComponent:TComponent):Boolean;
Begin
  result:=inherited IsValidDataSource(ASeries,AComponent);
  if not Result then result:=(AComponent is TDataSet) or (AComponent is TDataSource);
end;

Procedure TCustomDBChart.CheckNewDataSource(ADataSet:TDataSet; SingleRow:Boolean);
Var tmpDataSource : TDBChartDataSource;
Begin
  if IDataSources.IndexOf(ADataSet)=-1 then
  begin
    tmpDataSource:=TDBChartDataSource.Create(nil); { 5.02 }
    With tmpDataSource do
    begin
      SetDataSet(ADataSet,SingleRow);
      OnCheckDataSet:=DataSourceCheckDataSet;
      OnCloseDataSet:=DataSourceCloseDataSet;
    end;
    IDataSources.Add(tmpDataSource);
  end;
end;

Procedure TCustomDBChart.CheckDatasource(ASeries:TChartSeries);
Begin
  if Assigned(ASeries) then
  With ASeries do
    if ParentChart=Self then
    Begin
      if Assigned(DataSource) then
      Begin
        ASeries.Clear;
        if DataSource is TDataSet then
        Begin
          CheckNewDataSource(TDataSet(DataSource),False);
          CheckDataSet(TDataSet(DataSource),ASeries);
        end
        else
        if (DataSource is TDataSource) and Assigned(TDataSource(DataSource).DataSet) then
        begin
          CheckNewDataSource(TDataSource(DataSource).DataSet,True);
          CheckDataSet(TDataSource(DataSource).DataSet,ASeries);
        end
        else inherited;
      end
      else inherited;
    end
    else Raise ChartException.Create(TeeMsg_SeriesParentNoSelf);
end;

Procedure TCustomDBChart.CheckDataSet(ADataSet:TDataSet; ASeries:TChartSeries=nil);
Begin
  if FAutoRefresh then RefreshDataSet(ADataSet,ASeries);
end;

Procedure TCustomDBChart.DataSourceCheckDataSet(ADataSet:TDataSet);
begin
  CheckDataSet(ADataSet);
end;

Procedure TCustomDBChart.DataSourceCloseDataSet(ADataSet:TDataSet);
var t : Integer;
begin
  if FAutoRefresh then
     for t:=0 to SeriesCount-1 do
         if Series[t].DataSource=ADataSet then Series[t].Clear;
end;

type TValueListAccess=class(TChartValueList);

     TDBChartAgg=(dcaNone, dcaSum, dcaCount, dcaHigh, dcaLow, dcaAverage);
     TDBChartSeries=packed record
        ASeries     : TChartSeries;
        YManda      : Boolean;
        MandaList   : TChartValueList;
        LabelSort   : TChartListOrder;
        LabelField  : TField;
        ColorField  : TField;
        MandaField  : TField;
        NumFields   : Integer;
        GroupPrefix : TTeeDBGroup;
        AggPrefix   : TDBChartAgg;
     end;

     TDBChartSeriesList=Array of TDBChartSeries;

Procedure TCustomDBChart.RefreshDataSet(ADataSet:TDataSet; ASeries:TChartSeries);
Var HasAnyDataSet : Boolean;

  Procedure ProcessRecord(const tmpSeries:TDBChartSeries);
  var tmpxLabel : String;
      tmpColor  : TColor;
      tmpNotMand: Double;
      tmpMand   : Double;

    Procedure AddToSeries(const DestSeries:TDBChartSeries);
    Var t        : Integer;
        tmpIndex : Integer;
    begin
      With DestSeries do
      if AggPrefix<>dcaNone then
      begin
        tmpIndex:=ASeries.Labels.IndexOfLabel(tmpXLabel);

        if tmpIndex=-1 then { new point }
        begin
          if AggPrefix=dcaCount then tmpMand:=1
          else
          if AggPrefix=dcaAverage then tmpColor:=1;

          ASeries.Add(tmpMand,tmpXLabel,tmpColor);
        end
        else { existing point, do aggregation }
        With MandaList do
        Case AggPrefix of
          dcaSum:   Value[tmpIndex]:=Value[tmpIndex]+tmpMand;
          dcaCount: Value[tmpIndex]:=Value[tmpIndex]+1;
          dcaHigh:  if tmpMand>Value[tmpIndex] then Value[tmpIndex]:=tmpMand;
          dcaLow:   if tmpMand<Value[tmpIndex] then Value[tmpIndex]:=tmpMand;
          dcaAverage: begin
                        Value[tmpIndex]:=Value[tmpIndex]+tmpMand;
                        { trick: use the color as temporary count for average }
                        ASeries.ValueColor[tmpIndex]:=ASeries.ValueColor[tmpIndex]+1;
                      end;
        end;
      end
      else
      With DestSeries.ASeries do
      begin
        With ValuesList do
        for t:=2 to Count-1 do
            {$IFDEF CLR}
            if Assigned(TValueListAccess(ValueList[t]).IData) then
               TValueListAccess(ValueList[t]).TempValue:=TField(TValueListAccess(ValueList[t]).IData).AsFloat
            else
               TValueListAccess(ValueList[t]).TempValue:=0;
            {$ELSE}
            With TValueListAccess(ValueList[t]) do
            if Assigned(IData) then TempValue:=TField(IData).AsFloat
                               else TempValue:=0;
            {$ENDIF}

        if NotMandatoryValueList.ValueSource='' then
           if YManda then
              AddY(tmpMand,tmpXLabel,tmpColor)
           else
              AddX(tmpMand,tmpXLabel,tmpColor)
        else
           if YManda then { 5.01 }
              AddXY(tmpNotMand,tmpMand,tmpXLabel,tmpColor)
           else
              AddXY(tmpMand,tmpNotMand,tmpXLabel,tmpColor);
      end;
    end;

    Function GetFieldValue(AField:TField):Double;
    begin
      {$IFDEF CLR}
      result:=AField.AsFloat;
      {$ELSE}
      With AField do
      if FieldKind=fkAggregate then result:=Value
                               else result:=AsFloat;
      {$ENDIF}
    end;

    Procedure AddSingleRecord;
    var t       : Integer;
        tmpName : String;
    begin
      With tmpSeries do
      for t:=1 to NumFields do
      begin
        tmpName:=TeeExtractField(MandaList.ValueSource,t);
        if ASeries.XLabelsSource='' then tmpXLabel:=tmpName;

        if tmpName='' then
           tmpMand:=0
        else
           tmpMand:=GetFieldValue(ADataSet.FieldByName(tmpName));

        AddToSeries(tmpSeries);
      end;
    end;

    Function CalcXPos:String; { from DateTime to Label }
    var Year    : Word;
        Month   : Word;
        Day     : Word;
        Hour    : Word;
        Minute  : Word;
        Second  : Word;
        MSecond : Word;
    begin
      result:='';
      DecodeDate(tmpNotMand,Year,Month,Day);
      Case tmpSeries.GroupPrefix of
       dgHour: begin
                 DecodeTime(tmpNotMand,Hour,Minute,Second,MSecond);
                 result:=FormatDateTime('dd hh:nn',Trunc(tmpNotMand)+Hour/24.0);  // 5.02
               end;
        dgDay: result:=FormatDateTime('dd/MMM',Trunc(tmpNotMand)); // 5.02
       dgWeek: result:=TeeStr(DateToWeek(tmpNotMand,Year))+'/'+TeeStr(Year);
    dgWeekDay: result:=ShortDayNames[DayOfWeek(tmpNotMand)];
      dgMonth: result:=FormatDateTime('MMM/yy',EncodeDate(Year,Month,1));
    dgQuarter: result:=TeeStr(1+((Month-1) div 3))+'/'+TeeStr(Year); // 5.02
       dgYear: result:=FormatDateTime('yyyy',EncodeDate(Year,1,1));
      end;
    end;

  var tmpData : TObject;
  Begin
    With tmpSeries do
    Begin
      if GroupPrefix=dgNone then
         if Assigned(LabelField) then tmpXLabel:=LabelField.DisplayText
                                 else tmpXLabel:=''
      else
      begin
        tmpNotMand:=LabelField.AsFloat;
        tmpXLabel:=CalcXPos;
      end;

      if AggPrefix<>dcaNone then tmpColor:=clTeeColor
      else
      if Assigned(ColorField) then
         tmpColor:=ColorField.AsInteger
      else
      {$IFNDEF CLX} // CLX limitation
      if Assigned(MandaField) and MandaField.IsNull then
         tmpColor:=clNone
      else
      {$ENDIF}
         tmpColor:=clTeeColor;

      if NumFields=1 then
      begin
        if (not HasAnyDataSet) and (not Assigned(LabelField)) then
           tmpXLabel:=MandaList.ValueSource;

        tmpData:=TValueListAccess(ASeries.NotMandatoryValueList).IData;

        if Assigned(tmpData) then
           tmpNotMand:=TField(tmpData).AsFloat
//           ADataSet.GetFieldData(TField(tmpData), @tmpNotMand)  // v7 speed opt.
        else
           tmpNotMand:=0;

        if Assigned(MandaField) then tmpMand:=GetFieldValue(MandaField)
                                else tmpMand:=0;

        // add summary point
        AddToSeries(tmpSeries);
      end
      else AddSingleRecord
    end;
  end;

Var FListSeries : TDBChartSeriesList;

  Procedure FillTempSeriesList;

   Function GetDataSet(ASeries:TChartSeries):TDataSet;
   begin
     With ASeries do
     if DataSource is TDataSet then result:=TDataSet(DataSource)
     else
     if DataSource is TDataSource then
        result:=TDataSource(DataSource).DataSet
     else
        result:=nil;
   end;

   Function IsDataSet(ASeries:TChartSeries):Boolean;
   var tmp : TDataSet;
   begin
     tmp:=GetDataSet(ASeries);
     if Assigned(tmp) then
     begin
       result:=tmp=ADataSet;
       HasAnyDataSet:=ASeries.DataSource is TDataSet;
     end
     else result:=False;
   end;

   Procedure AddList(tmpSeries:TChartSeries);
   var tmp : TDataSet;

      Function GetAField(Const FieldName:String):TField;
      begin
        if FieldName='' then result:=nil
                        else result:=tmp.FieldByName(FieldName);
      end;

      Function GetAFieldPrefix(St:String; Var Prefix:String):TField;
      begin
        Prefix:=TeeGetDBPart(1,St);
        if Prefix<>'' then St:=TeeGetDBPart(2,St);
        result:=GetAField(St);
      end;