dbchart.pas

第三方控件：PaintGrid.pas 网格型仪表控件源文件 Mymeter.pas 圆型仪表控件源文件 Project1是这两个控件的使用范例。 该

                        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;

   var t        : Integer;
       tmpAgg   : String;
       tmpGroup : String;
       {$IFNDEF CLR}
       tmpV     : TValueListAccess;
       {$ENDIF}
   begin
     SetLength(FListSeries,Length(FListSeries)+1);
     With FListSeries[Length(FListSeries)-1] do
     begin
       ASeries   :=tmpSeries;
       YManda    :=ASeries.YMandatory;
       MandaList :=ASeries.MandatoryValueList;
       NumFields :=TeeNumFields(MandaList.ValueSource);

       tmp:=GetDataSet(ASeries);

       if Assigned(tmp) then
       With ASeries do
       begin
         LabelField:=GetAFieldPrefix(XLabelsSource,tmpGroup);

         // try to find #SORTASC# or #SORTDESC# in label grouping
         LabelSort:=StrToDBOrder(tmpGroup);
         if LabelSort=loNone then
            GroupPrefix:=StrToDBGroup(tmpGroup) // find #HOUR# etc
         else
            GroupPrefix:=dgNone;

         ColorField:=GetAField(ColorSource);
         MandaField:=GetAFieldPrefix(TeeExtractField(MandaList.ValueSource,1),tmpAgg);

         if tmpAgg<>'' then
         begin
           tmpAgg:=UpperCase(tmpAgg);
           if tmpAgg='SUM'   then AggPrefix:=dcaSum else
           if tmpAgg='COUNT' then AggPrefix:=dcaCount else
           if tmpAgg='HIGH'  then AggPrefix:=dcaHigh else
           if tmpAgg='LOW'   then AggPrefix:=dcaLow else
           if tmpAgg='AVG'   then AggPrefix:=dcaAverage else
                                  AggPrefix:=dcaNone;
         end
         else
         begin
           AggPrefix:=dcaNone;
           for t:=0 to ValuesList.Count-1 do
           begin
             {$IFDEF CLR}
             if ValuesList[t]<>MandaList then
                TValueListAccess(ValuesList[t]).IData:=GetAField(ValuesList[t].ValueSource);
             {$ELSE}
             tmpV:=TValueListAccess(ValuesList[t]);
             if tmpV<>MandaList then tmpV.IData:=GetAField(tmpV.ValueSource);
             {$ENDIF}
           end;
         end;
       end;
     end;
   end;

  var t         : Integer;
      tmpSeries : TChartSeries;
  begin
    FListSeries:=nil;
    if Assigned(ASeries) then
    begin
      AddList(ASeries);
      HasAnyDataSet:=ASeries.DataSource=ADataSet;
    end
    else
    for t:=0 to SeriesCount-1 do
    Begin
      tmpSeries:=Series[t];
      if IsDataSet(tmpSeries) and
         (tmpSeries.MandatoryValueList.ValueSource<>'') then
            AddList(tmpSeries);
    end;
  end;

  Procedure TraverseDataSet;
  Var b : TBookMark;
      t : Integer;
      tt: Integer;
  begin
    With ADataSet do
    begin
      DisableControls;
      try
        b:=GetBookMark;
        try
          First;
          While not EOF do
          try
            if Assigned(FOnProcessRecord) then FOnProcessRecord(Self,ADataSet);
            for t:=0 to Length(FListSeries)-1 do
                if FListSeries[t].ASeries.DataSource=ADataSet then
                   ProcessRecord(FListSeries[t]);
            Next;
          except
            on EAbort do break; { <-- exit while loop !!! }
          end;

          for t:=0 to Length(FListSeries)-1 do
          With FListSeries[t] do
          begin
            if AggPrefix=dcaAverage then
            begin
              for tt:=0 to ASeries.Count-1 do
              begin
                MandaList.Value[tt]:=MandaList.Value[tt]/ASeries.ValueColor[tt];
                ASeries.ValueColor[tt]:=clTeeColor;
              end;
            end;

            if (AggPrefix<>dcaNone) and (LabelSort<>loNone) then
               ASeries.SortByLabels(LabelSort);
          end;
        finally
          try
            GotoBookMark(b);
          finally
            FreeBookMark(b);
          end;
        end;
      finally
        EnableControls;
      end;
    end;
  end;

Var OldCursor : TCursor;
    t         : Integer;
    OldPaint  : Boolean;
Begin
  if not IUpdating then
  With ADataSet do
  if Active then
  Begin
    IUpdating:=True;
    FListSeries:=nil;
    HasAnyDataSet:=False;
    try
      FillTempSeriesList;
      if Length(FListSeries)>0 then
      Begin
        OldCursor:=Screen.Cursor;
        if FShowGlassCursor then Screen.Cursor:=crHourGlass;

        OldPaint:=AutoRepaint;
        AutoRepaint:=False;
        try
          for t:=0 to Length(FListSeries)-1 do
              FListSeries[t].ASeries.Clear;
          if HasAnyDataSet then TraverseDataSet
          else
          begin
            {$IFDEF TEEOCX}
            ADataSet.Resync([]);
            {$ENDIF}
            if Assigned(FOnProcessRecord) then FOnProcessRecord(Self,ADataSet);
            for t:=0 to Length(FListSeries)-1 do
                if TDataSource(FListSeries[t].ASeries.DataSource).DataSet=ADataSet then
                begin
                  ProcessRecord(FListSeries[t]);
                end;
          end;

          for t:=0 to Length(FListSeries)-1 do
          begin
            FListSeries[t].ASeries.CheckOrder;
            FListSeries[t].ASeries.RefreshSeries;
          end;
        finally
          AutoRepaint:=OldPaint;
          Invalidate;
          if FShowGlassCursor then Screen.Cursor:=OldCursor;
        end;
      end;
    finally
      FListSeries:=nil;
      IUpdating:=False;
    end;
  end;
end;

Procedure TCustomDBChart.RefreshData;
var t : Integer;
Begin
  for t:=0 to IDataSources.Count-1 do
      RefreshDataSet(IDataSources[t].DataSet,nil);
End;

Procedure FillDataSetFields(DataSet:TDataSet; Proc:TGetStrProc);
var t : Integer;
begin
  with DataSet do
  begin
    if FieldCount > 0 then
       for t:=0 to FieldCount-1 do Proc(Fields[t].FieldName)
    else
    Begin
      FieldDefs.Update;
      for t:=0 to FieldDefs.Count-1 do Proc(FieldDefs[t].Name);
    end;
  end;
end;

Procedure TCustomDBChart.FillSeriesSourceItems(ASeries:TChartSeries; Proc:TGetStrProc);
Begin
  With ASeries do
  if Assigned(DataSource) then
  begin
    if DataSource is TDataSource then
       FillDataSetFields(TDataSource(DataSource).DataSet,Proc)
    else
    if DataSource is TDataSet then
       FillDataSetFields(TDataSet(DataSource),Proc);
  end;
end;

Procedure TCustomDBChart.FillValueSourceItems(AValueList:TChartValueList; Proc:TGetStrProc);
Begin
  With AValueList.Owner do
  if Assigned(DataSource) then
  Begin
    if (DataSource is TDataSet) or (DataSource is TDataSource) then
       FillSeriesSourceItems(AValueList.Owner,Proc)
    else
       inherited;
  end;
end;

Procedure TCustomDBChart.Assign(Source:TPersistent);
begin
  if Source is TCustomDBChart then
  With TCustomDBChart(Source) do
  begin
    Self.AutoRefresh    :=AutoRefresh;
    Self.RefreshInterval:=RefreshInterval;
    Self.ShowGlassCursor:=ShowGlassCursor;
  end;
  inherited;
end;

{ 5.01 Reported by : Timo Goebel <[e-mail]> }
Function DateToWeek(ADate:TDateTime; Var Year:Word):Integer;
const FirstWeekDay  = 2;  // 2: Monday (ISO-8601)
      FirstWeekDate = 4; // 4: First four day-week (ISO-8601)
var Month : Word;
    Day   : Word;
begin
  ADate:=ADate-((DayOfWeek(ADate)-FirstWeekDay+7) mod 7)+ 7-FirstWeekDate;
  DecodeDate(ADate,Year,Month,Day);
  Result:=(Trunc(ADate-EncodeDate(Year,1,1)) div 7)+1;
end;

Function DateToWeekOld(Const ADate:TDateTime; Var Year:Word):Integer;
Const FirstDay=0; { Monday }
Var d,m,y,j,j0,j1,Week : Word;
begin
  DecodeDate(ADate,y,m,d);
  if (m < 3) then
    j := 1461*(y-1) div 4 + (153*(m+9)+2) div 5 + d
  else
    j := 1461*y div 4 + (153*(m-3)+2) div 5 + d;

  j0:=1461*(y-1) DIV 4 + 310;
  j0:=j0-(j0-FirstDay) MOD 7;

  If (j<j0) then
  begin
    j0 := 1461*(y-2) DIV 4 + 310;
    j0 := j0 - (j0-FirstDay) MOD 7;
    Week:=1 + (j-j0) DIV 7;
    Year:=y-1;
  end
  else
  begin
    j1 := 1461*y div 4 + 310;
    j1 := j1 - (j1-FirstDay) mod 7;
    if j<j1 then
    begin
      Week:=1 + (j-j0) div 7;
      Year:=y;
    end
    else
    begin
      Week:=1;
      Year:=y+1;
    end;
  end;
  result:=Week;
End;

Function TeeFieldType(AType:TFieldType):TTeeFieldType;
begin
  // Pending fix in VCLDBRtl.dll ...
  Case AType of
    {$IFDEF CLR}TFieldType.{$ENDIF}ftAutoInc,
    {$IFDEF CLR}TFieldType.{$ENDIF}ftCurrency,
    {$IFDEF CLR}TFieldType.{$ENDIF}ftFloat,
    {$IFDEF CLR}TFieldType.{$ENDIF}ftInteger,
    {$IFDEF CLR}TFieldType.{$ENDIF}ftLargeInt,
    {$IFDEF CLR}TFieldType.{$ENDIF}ftSmallint,
    {$IFDEF CLR}TFieldType.{$ENDIF}ftWord,
    {$IFDEF CLR}TFieldType.{$ENDIF}ftBCD        : result:=tftNumber;

    {$IFDEF CLR}TFieldType.{$ENDIF}ftDate,
    {$IFDEF CLR}TFieldType.{$ENDIF}ftTime,

    {$IFDEF D7}
    {$IFDEF CLR}TFieldType.{$ENDIF}ftTimeStamp,
    {$ENDIF}

    {$IFDEF CLR}TFieldType.{$ENDIF}ftDateTime   : result:=tftDateTime;
    {$IFDEF CLR}TFieldType.{$ENDIF}ftString,
    {$IFDEF CLR}TFieldType.{$ENDIF}ftFixedChar,
    {$IFDEF CLR}TFieldType.{$ENDIF}ftWideString : result:=tftText;
  else
    result:=tftNone;
  end;
end;

Function TeeGetDBPart(Num:Integer; St:String):String;
var i : Integer;
begin
  result:='';
  if Copy(St,1,1)='#' then
  begin
    Delete(St,1,1);
    i:=Pos('#',St);
    if i>0 then
       if Num=1 then result:=Copy(St,1,i-1)
       else
       if Num=2 then result:=Copy(St,i+1,Length(St)-i);
  end;
end;

Function StrToDBGroup(St:String):TTeeDBGroup;
begin
  St:=UpperCase(St);
  if St='HOUR' then result:=dgHour else
  if St='DAY' then result:=dgDay else
  if St='WEEK' then result:=dgWeek else
  if St='WEEKDAY' then result:=dgWeekDay else
  if St='MONTH' then result:=dgMonth else
  if St='QUARTER' then result:=dgQuarter else
  if St='YEAR' then result:=dgYear else
     result:=dgNone;
end;

Function StrToDBOrder(St:String):TChartListOrder;
begin
  St:=UpperCase(St);
  if St='SORTASC' then result:=loAscending
  else
  if St='SORTDES' then result:=loDescending
  else
     result:=loNone;
end;

end.