teedata.pas

TeeChart7Source 控件

{******************************************}
{  TeeChart Series DB Virtual DataSet      }
{ Copyright (c) 1996-2004 by David Berneda }
{          All Rights Reserved             }
{******************************************}
unit TeeData;
{$I TeeDefs.inc}

{ This unit contains a VIRTUAL TDATASET component.

  The TSeriesDataSet component is an intermediary between a
  Series component and a TDataSource.

  You can show Series values in a DBGrid, for example:

  SeriesDataSet1.Series := Series1;
  DataSource1.DataSet   := SeriesDataSet1;
  DBGrid1.DataSource    := DataSource1;

  To refresh data:

  SeriesDataSet1.Close;
  Series1.Add(....)
  SeriesDataSet1.Open;

  Additional information under Delphi \Demos\TextData example project.

  NOTE: This component is not available in Delphi and C++ Builder
        STANDARD versions, because they do not include Database components.

}
interface

uses DB, Classes,
     {$IFDEF CLX}
     QGraphics,
     {$ELSE}
     Graphics,
     {$ENDIF}
     TeEngine, TeeProcs;

Const MaxLabelLen=128;

type
  PFloat=^Double;
  PSeriesPoint=^TSeriesPoint;
  TSeriesPoint=packed record
    Color  : TColor;  { 4 bytes }
    X      : Double;  { 8 bytes }
    Values : Array[0..10] of Double; { 88 bytes }
    ALabel : String[MaxLabelLen];    { 128 bytes }
  end;

  PRecInfo = ^TRecInfo;
  TRecInfo = packed record
    Bookmark     : Integer;
    BookmarkFlag : TBookmarkFlag;
  end;

  TSeriesDataSet = class(TDataSet,ITeeEventListener)
  private
    FSeries       : TChartSeries;
    FBookMarks    : TList;
    FCurRec       : Integer;
    FLastBookmark : Integer;
    Procedure DoCreateField(Const AFieldName:String; AType:TFieldType; ASize:Integer);
    Function RecInfoOfs: Integer;
    Function RecBufSize: Integer;
    procedure TeeEvent(Event: TTeeEvent);
  protected
    { Overriden abstract methods (required) }
    function AllocRecordBuffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}; override;
    procedure FreeRecordBuffer(var Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}); override;
    {$IFDEF CLR}
    procedure GetBookmarkData(Buffer: TRecordBuffer; var Bookmark: TBookmark); override;
    {$ELSE}
    procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
    {$ENDIF}

    function GetBookmarkFlag(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}): TBookmarkFlag; override;

    function GetRecord(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    function GetRecordSize: Word; override;
    procedure InternalAddRecord(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}Pointer{$ENDIF}; Append: Boolean); override;
    procedure InternalClose; override;
    procedure InternalDelete; override;
    procedure InternalFirst; override;
    procedure InternalGotoBookmark({$IFDEF CLR}const Bookmark:TBookmark{$ELSE}Bookmark: Pointer{$ENDIF}); override;
    procedure InternalHandleException; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalInitRecord(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}); override;
    procedure InternalLast; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    procedure InternalSetToRecord(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}); override;
    function IsCursorOpen: Boolean; override;

    procedure Notification( AComponent: TComponent;
                            Operation: TOperation); override;

    procedure SetBookmarkFlag(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}; Value: TBookmarkFlag); override;

    {$IFDEF CLR}
    procedure SetBookmarkData(Buffer: TRecordBuffer; const Bookmark: TBookmark); override;
    {$ELSE}
    procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
    {$ENDIF}

    procedure SetFieldData(Field: TField; Buffer: {$IFDEF CLR}TValueBuffer{$ELSE}Pointer{$ENDIF}); override;

    { Additional overrides (optional) }
    function GetRecordCount: Integer; override;
    function GetRecNo: Integer; override;
    procedure SetRecNo(Value: Integer); override;
    Procedure SetSeries(ASeries:TChartSeries); virtual;
    Procedure AddSeriesPoint(Buffer:{$IFDEF CLR}IntPtr{$ELSE}Pointer{$ENDIF}; ABookMark:Integer); virtual;
  public
    function GetFieldData(Field: TField; Buffer: {$IFDEF CLR}TValueBuffer{$ELSE}Pointer{$ENDIF}): Boolean; override;
  published
    property Series: TChartSeries read FSeries write SetSeries stored True;
    property Active;
  end;

implementation

uses {$IFNDEF LINUX}
     Windows,
     {$ENDIF}
     SysUtils,
     {$IFDEF CLX}
     QForms,
     {$ELSE}
     Forms,
     {$ENDIF}
     TeeConst, TeCanvas;

{ TSeriesDataSet }

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

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;

Function TSeriesDataSet.RecBufSize: Integer;
begin
  result:=RecInfoOfs + SizeOf(TRecInfo);
end;

procedure TSeriesDataSet.InternalOpen;
var I: Integer;
begin
  if not Assigned(FSeries) then
     Raise Exception.Create('Cannot open SeriesDataSet. No Series assigned.');
  { Fabricate integral bookmark values }
  FBookMarks:=TList.Create;
  for I:=1 to FSeries.Count do FBookMarks.Add({$IFDEF CLR}TObject{$ELSE}Pointer{$ENDIF}(I));
  FLastBookmark:=FSeries.Count;

  FCurRec:=-1;

  BookmarkSize := SizeOf(Integer);

  InternalInitFieldDefs;
  if DefaultFields then CreateFields;
  BindFields(True);
end;

procedure TSeriesDataSet.InternalClose;
begin
  {$IFDEF D5}
  FreeAndNil(FBookMarks);
  {$ELSE}
  FBookMarks.Free;
  FBookMarks:=nil;
  {$ENDIF}
  if DefaultFields then DestroyFields;
  FLastBookmark := 0;
  FCurRec := -1;
end;

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

Procedure TSeriesDataSet.DoCreateField(Const AFieldName:String; AType:TFieldType; ASize:Integer);
begin
  {$IFDEF C3D4}
  With TFieldDef.Create(FieldDefs) do
  begin
    Name      := AFieldName;
    Size      := ASize;
    Required  := False;
    DataType  := AType;
  end;
  {$ELSE}
  TFieldDef.Create(FieldDefs, AFieldName, AType, ASize, False, FieldDefs.Count+1)
  {$ENDIF}
end;

procedure TSeriesDataSet.InternalInitFieldDefs;

  Function GetFieldName(Const ADefault,AName:String):String;
  begin
    if AName='' then result:=ADefault
                else result:=AName;
  end;

  Procedure AddField(IsDateTime:Boolean; Const FieldName:String);
  begin
    if IsDateTime then DoCreateField(FieldName,ftDateTime,0)
                  else DoCreateField(FieldName,ftFloat,0);
  end;

var tmp:String;
    t:Integer;
begin
  FieldDefs.Clear;
  if Assigned(FSeries) then
  begin
    {$IFDEF C3D4}
    With TFieldDef.Create(FieldDefs) do
    begin
      Name:='Color';
      DataType:=ftInteger;
      Size:=0;
      Required:=False;
      FieldNo:=1;
    end;
    {$ELSE}
    TFieldDef.Create(FieldDefs, 'Color', ftInteger, 0, False, 1);
    {$ENDIF}
    With FSeries.XValues do AddField(DateTime,GetFieldName('X',Name));
    With FSeries.YValues do AddField(DateTime,GetFieldName('Y',Name));
    {$IFDEF C3D4}
    With TFieldDef.Create(FieldDefs) do
    begin
      Name:='Label';
      DataType:=ftString;
      Size:=MaxLabelLen;
      Required:=False;
      FieldNo:=4;
    end;
    {$ELSE}
    TFieldDef.Create(FieldDefs, 'Label', ftString, MaxLabelLen, False, 4);
    {$ENDIF}