teedata.pas

BCB第三方组件

  TFieldDef.Create(FieldDefs, GetFieldName('','Label'), ftString, MaxLabelLen, False, 4);
  {$ENDIF}

  for t:=2 to Series.ValuesList.Count-1 do
  With Series.ValuesList[t] do
  begin
    tmp:=Name;

    if Name='' then tmp:='Value'+TeeStr(t)
               else tmp:=Name;

    AddField(DateTime,GetFieldName('',tmp));
  end;
end;

procedure TTeeDataSet.SetSeriesBuffer(FieldIndex:Integer; const Active:TSeriesPoint; Buffer:Pointer; Series:TChartSeries);

   Function GetAValue(IsDateTime:Boolean):TChartValue;
   begin
     result:=PChartValue(Buffer)^;

     if IsDateTime then
        result:=TimeStampToDateTime(MSecsToTimeStamp(result));
   end;

begin
  with PSeriesPoint(ActiveBuffer)^ do
  Case FieldIndex of
    1: Color:=PInteger(Buffer)^;
    2: X:=GetAValue(Series.XValues.DateTime);
    3: Values[0]:=GetAValue(Series.YValues.DateTime);
    4: ALabel:=PChar(Buffer);
  else
    Values[FieldIndex-4]:=GetAValue(Series.ValuesList[FieldIndex-3].DateTime);
  end;
end;

procedure TTeeDataSet.SetFieldData(Field: TField; Buffer: Pointer);
begin
  DataEvent(deFieldChange, Integer(Field));
end;

function TTeeDataSet.GetRecord(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}; GetMode: TGetMode; DoCheck: Boolean): TGetResult;
begin
  result:=grError;

  if IsCursorOpen then
  begin
    if RecordCount < 1 then Result := grEOF
    else
    begin
      Result := grOK;

      case GetMode of
        gmNext: if FCurRec >= RecordCount - 1  then result:=grEOF
                                               else Inc(FCurRec);
       gmPrior: if FCurRec <= 0 then result:=grBOF
                                else Dec(FCurRec);

     gmCurrent: if (FCurRec < 0) or (FCurRec >= RecordCount) then
                   result := grError;
      end;

      if result=grOK then
      begin
        DoFillBuffer(Buffer);

        with PRecInfo(Buffer + RecInfoOfs)^ do
        begin
          BookmarkFlag := bfCurrent;

          if Assigned(FBookMarks) and (FBookMarks.Count>FCurRec) and
             Assigned(FBookMarks[FCurRec]) then
             Bookmark := Integer(FBookMarks[FCurRec])
          else
             BookMark := -1;
        end;

      end
      else
      if (Result = grError) and DoCheck then
         DatabaseError('No Records');
    end;
  end
  else
  if DoCheck then DatabaseError('No Records');
end;

Procedure TTeeDataSet.FillSeriesBuffer(var Buffer:TSeriesPoint; Series:TChartSeries);
var t : Integer;
begin
  With Buffer do
  begin
    Color:=Series.ValueColor[FCurRec];
    X:=Series.XValues.Value[FCurRec];
    ALabel:=Series.Labels[FCurRec];

    for t:=1 to Series.ValuesList.Count-1 do
        Values[t-1]:=Series.ValuesList[t].Value[FCurRec];
  end;
end;

function TTeeDataSet.GetSeriesBuffer(FieldIndex:Integer; var Active:TSeriesPoint; Buffer: Pointer; Series:TChartSeries):Boolean;

   Function GetSeriesValue(AList:TChartValueList):TChartValue;
   var t : Integer;
   begin
     if AList=Series.XValues then
        result:=Active.X
     else
     begin
       result:=0;

       for t:=1 to Series.ValuesList.Count-1 do
       if AList=Series.ValuesList[t] then
       begin
         result:=Active.Values[t-1];
         break;
       end;
     end;

     if AList.DateTime then
        result:=TimeStampToMSecs(DateTimeToTimeStamp(result));
   end;

begin
  result:=Series.Count>0;

  if result and Assigned(Buffer) then
  Case FieldIndex of
    1: PInteger(Buffer)^:=Active.Color;
    2: PChartValue(Buffer)^:=GetSeriesValue(Series.XValues);
    3: PChartValue(Buffer)^:=GetSeriesValue(Series.YValues);
    4: begin
         StrPCopy(Buffer,Active.ALabel);
         result := PChar(Buffer)^ <> #0;
       end;
    else
    begin
      PChartValue(Buffer)^:=GetSeriesValue(Series.ValuesList[FieldIndex-3]);
    end;
  end;
end;

Procedure TTeeDataSet.DoAddSeriesPoint(const Buffer:TSeriesPoint; Series:TChartSeries);
var t : Integer;
begin
  With Buffer do
  begin
    for t:=2 to Series.ValuesList.Count-1 do
        Series.ValuesList[t].TempValue:=Values[t-1];

    Series.AddXY(X,Values[0],ALabel,Color);
  end;
end;

procedure TTeeDataSet.PostToSeries(Series:TChartSeries; const Buffer:TSeriesPoint);
var t : Integer;
begin
  With Buffer do
  Begin
    Series.ValueColor[FCurRec]:=Color;
    Series.XValues.Value[FCurRec]:=X;
    Series.YValues.Value[FCurRec]:=Values[0];
    Series.Labels[FCurRec]:=ALabel;

    for t:=2 to Series.ValuesList.Count-1 do
        Series.ValuesList[t].Value[FCurRec]:=Values[t-1];
  end;
end;

procedure TTeeDataSet.InternalPost;
begin
  if State <> dsEdit then
  begin
    Inc(FLastBookmark);
    FBookMarks.Add(Pointer(FLastBookMark));
  end;
end;

{ TSeriesDataSet }

{$IFNDEF CLR}
type
  TTeePanelAccess=class(TCustomTeePanel);
{$ENDIF}

Procedure TSeriesDataSet.DoFillBuffer(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF});
begin
  FillSeriesBuffer(PSeriesPoint(Buffer)^,FSeries);
end;

Procedure TSeriesDataSet.SetSeries(ASeries:TChartSeries);
Var WasActive : Boolean;
begin
  WasActive:=Active;
  Active:=False;

  if Assigned(FSeries) then
  begin
    {$IFDEF D5}
    FSeries.RemoveFreeNotification(Self);
    {$ENDIF}

    if Assigned(FSeries.ParentChart) then
       {$IFNDEF CLR}TTeePanelAccess{$ENDIF}(FSeries.ParentChart).RemoveListener(Self);
  end;

  FSeries:=ASeries;

  if Assigned(FSeries) then
  begin
    FSeries.FreeNotification(Self);
    if Assigned(FSeries.ParentChart) then
       {$IFNDEF CLR}TTeePanelAccess{$ENDIF}(FSeries.ParentChart).Listeners.Add(Self);
  end;

  if Assigned(FSeries) and WasActive then
     Active:=True;
end;

procedure TSeriesDataSet.Notification( AComponent: TComponent;
                            Operation: TOperation);
begin
  inherited;

  if (Operation=opRemove) and Assigned(FSeries) and (AComponent=FSeries) then
     Series:=nil;
end;

Function TSeriesDataSet.RecInfoOfs:Integer;
begin
  result:=SizeOf(TSeriesPoint);
end;

procedure TSeriesDataSet.InternalOpen;
begin
  if not Assigned(FSeries) then
     Raise Exception.Create('Cannot open SeriesDataSet. No Series assigned.');

  inherited;
end;

function TSeriesDataSet.IsCursorOpen: Boolean;
begin
  Result:=(inherited IsCursorOpen) and Assigned(FSeries);
end;

procedure TSeriesDataSet.InternalInitFieldDefs;
begin
  FieldDefs.Clear;

  if Assigned(FSeries) then
     AddSeriesFields(FSeries);
end;

function TSeriesDataSet.GetRecordSize: Word;
begin
  if Assigned(FSeries) then result:=SizeOf(TSeriesPoint)
                       else result:=0;
end;

function TSeriesDataSet.GetFieldData(Field: TField; Buffer: Pointer): Boolean;
begin
  result:=(ActiveBuffer<>nil) and GetSeriesBuffer(Field.FieldNo,PSeriesPoint(ActiveBuffer)^,Buffer,Series);
end;

procedure TSeriesDataSet.SetFieldData(Field: TField; Buffer: Pointer);
begin
  if ActiveBuffer<>nil then
     SetSeriesBuffer(Field.FieldNo,PSeriesPoint(ActiveBuffer)^,Buffer,FSeries);

  inherited;
end;

procedure TSeriesDataSet.InternalPost;
begin
  if State = dsEdit then
     PostToSeries(FSeries,PSeriesPoint(ActiveBuffer)^)
  else
     DoAddSeriesPoint(PSeriesPoint(ActiveBuffer)^,FSeries);

  inherited;
end;

procedure TSeriesDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
begin
  inherited;
  DoAddSeriesPoint(PSeriesPoint(Buffer)^,FSeries);
  FBookMarks.Add(Pointer(FLastBookMark));
end;

procedure TSeriesDataSet.InternalDelete;
begin
  FSeries.Delete(FCurRec);
  inherited;
end;

function TSeriesDataSet.GetRecordCount: Integer;
begin
  Result:=FSeries.Count;
end;

procedure TSeriesDataSet.TeeEvent(Event: TTeeEvent);
begin
  if Active and (Event is TTeeSeriesEvent) and
     (TTeeSeriesEvent(Event).Event=seDataChanged) then
  begin
    Close;
    Open;
  end;
end;

{ TChartDataset }

Procedure TChartDataSet.SetChart(Value:TCustomChart);
Var WasActive : Boolean;
begin
  WasActive:=Active;
  Active:=False;

  if Assigned(FChart) then
  begin
    {$IFDEF D5}
    FChart.RemoveFreeNotification(Self);
    {$ENDIF}

    {$IFNDEF CLR}TTeePanelAccess{$ENDIF}(FChart).RemoveListener(Self);
  end;

  FChart:=Value;

  if Assigned(FChart) then
  begin
    FChart.FreeNotification(Self);

    {$IFNDEF CLR}TTeePanelAccess{$ENDIF}(FChart).Listeners.Add(Self);
  end;

  if Assigned(FChart) and WasActive then
     Active:=True;
end;

procedure TChartDataSet.TeeEvent(Event: TTeeEvent);

  function ValidEvent(Value:TChartSeriesEvent):Boolean;
  begin
    result:=(Value=seAdd) or (Value=seRemove) or (Value=seDataChanged);
  end;

begin
  if Active and (Event is TTeeSeriesEvent) and
     ValidEvent(TTeeSeriesEvent(Event).Event) then
  begin
    Close;
    Open;
  end;
end;

function TChartDataSet.GetRecordSize: Word;
begin
  result:=FChart.SeriesCount*SizeOf(TSeriesPoint);
end;

procedure TChartDataSet.InternalDelete;
var t : Integer;
begin
  for t:=0 to FChart.SeriesCount-1 do
      if FChart[t].Count>FCurRec then
         FChart[t].Delete(FCurRec);

  inherited;
end;

function TChartDataSet.GetRecordCount: Integer;
var t : Integer;
begin
  result:=0;

  for t:=0 to FChart.SeriesCount-1 do
  With FChart[t] do
       if (t=0) or (Count>result) then
           result:=Count;
end;

function TChartDataSet.IsCursorOpen: Boolean;
begin
  Result:=(inherited IsCursorOpen) and Assigned(FChart);
end;

procedure TChartDataSet.InternalOpen;
begin
  if not Assigned(FChart) then
     Raise Exception.Create('Cannot open Chart DataSet. No Chart assigned.');

  inherited;
end;

procedure TChartDataSet.InternalInitFieldDefs;
var t : Integer;
begin
  FieldDefs.Clear;

  for t:=0 to FChart.SeriesCount-1 do
     AddSeriesFields(FChart[t],FChart.SeriesCount>1);
end;

procedure TChartDataSet.CalcFieldSeries(Field:Integer; var Index,Series:Integer);
begin
  Index:=Field;
  Series:=0;

  while Index>(2+FChart[Series].ValuesList.Count) do
  begin
    Dec(Index,(2+FChart[Series].ValuesList.Count));
    Inc(Series);
  end;
end;

procedure TChartDataSet.SetFieldData(Field: TField; Buffer: Pointer);
var tmpIndex  : Integer;
    tmpSeries : Integer;
begin
  if ActiveBuffer<>nil then
  begin
    CalcFieldSeries(Field.FieldNo,tmpIndex,tmpSeries);
    SetSeriesBuffer(tmpIndex,PSeriesPoints(ActiveBuffer)[tmpSeries],Buffer,FChart[tmpSeries]);
  end;

  inherited;
end;

Function TChartDataSet.RecInfoOfs:Integer;
begin
  result:=SizeOf(TSeriesPoint);

  if Assigned(FChart) then
     result:=result*FChart.SeriesCount;
end;

Procedure TChartDataSet.DoFillBuffer(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF});
var t : Integer;
begin
  for t:=0 to FChart.SeriesCount-1 do
      FillSeriesBuffer(TSeriesPoint(PSeriesPoints(Buffer)[t]),FChart[t]);
end;

function TChartDataSet.GetFieldData(Field: TField; Buffer: {$IFDEF CLR}TValueBuffer{$ELSE}Pointer{$ENDIF}): Boolean;
var tmpIndex  : Integer;
    tmpSeries : Integer;
begin
  CalcFieldSeries(Field.FieldNo,tmpIndex,tmpSeries);
  result:=(ActiveBuffer<>nil) and GetSeriesBuffer(tmpIndex,PSeriesPoints(ActiveBuffer)[tmpSeries],Buffer,FChart[tmpSeries]);
end;

procedure TChartDataSet.InternalPost;
var t : Integer;
begin
  for t:=0 to FChart.SeriesCount-1 do
  if State = dsEdit then
     PostToSeries(FChart[t],PSeriesPoints(ActiveBuffer)[t])
  else
     DoAddSeriesPoint(PSeriesPoints(ActiveBuffer)[t],FChart[t]);

  inherited;
end;

procedure TChartDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
var t : Integer;
begin
  inherited;

  for t:=0 to FChart.SeriesCount-1 do
      DoAddSeriesPoint(PSeriesPoints(Buffer)[t],FChart[t]);

  FBookMarks.Add(Pointer(FLastBookMark));
end;

end.