teedata.pas

BCB第三方组件

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

{$R-}

{ This unit contains two VIRTUAL TDATASET derived components.

  1) 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;

  2) The TChartDataSet component is an intermediary between a
  Chart (or DBChart or QRChart) component and a TDataSource.

  ChartDataSet1.Chart := Chart1;
  DataSource1.DataSet := ChartDataSet1;
  DBGrid1.DataSource  := DataSource1;

  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, Chart;

Const
  MaxLabelLen=128;

type
  PSeriesPoint=^TSeriesPoint;
  TSeriesPoint=packed record
    Color  : TColor; { 4 bytes (TColor is 4 bytes Integer in x86) }
    X      : TChartValue;  { 8 bytes by default TChartValue is a Double }
    Values : Array[0..10] of TChartValue; { 10*SizeOf(TChartValue) (88 bytes by default) }
    ALabel : String[MaxLabelLen]; { 128 bytes }
  end;

  PSeriesPoints=^TSeriesPoints;
  TSeriesPoints=packed Array[0..0] of TSeriesPoint;

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

  TTeeDataSet=class(TDataSet)
  private
    FBookMarks    : TList;
    FCurRec       : Integer;
    FLastBookmark : Integer;

    IAllocated    : Integer;
    
    Procedure DoCreateField(Const AFieldName:String; AType:TFieldType; ASize:Integer);
    Function RecBufSize: Integer;
  protected
    procedure AddSeriesFields(Series:TChartSeries; PrefixSeriesName:Boolean=False);

    function AllocRecordBuffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}; override;

    Procedure DoAddSeriesPoint(const Buffer:TSeriesPoint; Series:TChartSeries);
    Procedure DoFillBuffer(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}); virtual; abstract;
    Procedure FillSeriesBuffer(var Buffer:TSeriesPoint; Series:TChartSeries);

    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 GetRecNo: Integer; override;
    function GetRecord(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
    function GetSeriesBuffer(FieldIndex:Integer; var Active:TSeriesPoint; Buffer: Pointer; Series:TChartSeries):Boolean;

    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 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 PostToSeries(Series:TChartSeries; const Buffer:TSeriesPoint);

    Function RecInfoOfs:Integer; virtual; abstract;

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

    procedure SetBookmarkFlag(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}; Value: TBookmarkFlag); override;
    procedure SetFieldData(Field: TField; Buffer: {$IFDEF CLR}TValueBuffer{$ELSE}Pointer{$ENDIF}); override;
    procedure SetRecNo(Value: Integer); override;

    procedure SetSeriesBuffer(FieldIndex:Integer; const Active:TSeriesPoint; Buffer:Pointer; Series:TChartSeries);
  public
  published
    property Active;
    property AutoCalcFields;
    property BeforeOpen;
    property AfterOpen;
    property BeforeClose;
    property AfterClose;
    property BeforeInsert;
    property AfterInsert;
    property BeforeEdit;
    property AfterEdit;
    property BeforePost;
    property AfterPost;
    property BeforeCancel;
    property AfterCancel;
    property BeforeDelete;
    property AfterDelete;
    property BeforeScroll;
    property AfterScroll;

    {$IFDEF D5}
    property AfterRefresh;
    property BeforeRefresh;
    {$ENDIF}

    property OnCalcFields;
    property OnDeleteError;
    property OnEditError;
    property OnNewRecord;
    property OnPostError;
  end;

  TSeriesDataSet = class(TTeeDataSet,ITeeEventListener)
  private
    FSeries       : TChartSeries;

    procedure TeeEvent(Event: TTeeEvent);
  protected

    { Overriden abstract methods (required) }
    Procedure DoFillBuffer(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}); override;
    function GetRecordSize: Word; override;

    procedure InternalAddRecord(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}Pointer{$ENDIF}; Append: Boolean); override;
    procedure InternalDelete; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    function IsCursorOpen: Boolean; override;

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

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

    { Additional overrides (optional) }
    function GetRecordCount: Integer; override;
    Function RecInfoOfs: Integer; override;
    Procedure SetSeries(ASeries:TChartSeries); 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;
  end;

  TChartDataSet = class(TTeeDataSet,ITeeEventListener)
  private
    FChart : TCustomChart;

    procedure CalcFieldSeries(Field:Integer; var Index,Series:Integer);
    procedure SetChart(Value:TCustomChart);
    procedure TeeEvent(Event: TTeeEvent);
  protected
    Procedure DoFillBuffer(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}); override;
    function GetRecordCount: Integer; override;
    function GetRecordSize: Word; override;
    procedure InternalAddRecord(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}Pointer{$ENDIF}; Append: Boolean); override;
    procedure InternalDelete; override;
    procedure InternalInitFieldDefs; override;
    procedure InternalOpen; override;
    procedure InternalPost; override;
    function IsCursorOpen: Boolean; override;
    Function RecInfoOfs: Integer; override;
    procedure SetFieldData(Field: TField; Buffer: {$IFDEF CLR}TValueBuffer{$ELSE}Pointer{$ENDIF}); override;
  public
    function GetFieldData(Field: TField; Buffer: {$IFDEF CLR}TValueBuffer{$ELSE}Pointer{$ENDIF}): Boolean; override;
  published
    property Chart:TCustomChart read FChart write SetChart;
  end;

implementation

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

type
  PChartValue=^TChartValue;

{ TTeeDataset }
Function TTeeDataSet.RecBufSize: Integer;
begin
  result:=RecInfoOfs + SizeOf(TRecInfo);
end;

procedure TTeeDataSet.InternalClose;
begin
  {$IFDEF D5}
  FreeAndNil(FBookMarks);
  {$ELSE}
  FBookMarks.Free;
  FBookMarks:=nil;
  {$ENDIF}

  if DefaultFields then
     DestroyFields;

  FLastBookmark := 0;
  FCurRec := -1;
end;

Procedure TTeeDataSet.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 TTeeDataSet.InternalHandleException;
begin
  Application.HandleException(Self);
end;

procedure TTeeDataSet.InternalDelete;
begin
  FBookMarks.Delete(FCurRec);

  if FCurRec >= RecordCount then
     Dec(FCurRec);
end;

procedure TTeeDataSet.InternalGotoBookmark({$IFDEF CLR}const Bookmark:TBookmark{$ELSE}Bookmark: Pointer{$ENDIF});
var Index: Integer;
begin
  Index := FBookMarks.IndexOf({$IFDEF CLR}Bookmark{$ELSE}Pointer(PInteger(Bookmark)^){$ENDIF});
  if Index <> -1 then
     FCurRec := Index
  else
     DatabaseError('Bookmark not found');
end;

procedure TTeeDataSet.InternalSetToRecord(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF});
begin
  {$IFDEF CLR}
  InternalGotoBookmark(TRecordBuffer(Longint(Buffer) + FBookmarkOfs));
  {$ELSE}
  InternalGotoBookmark(@PRecInfo(Buffer + RecInfoOfs).Bookmark);
  {$ENDIF}
end;

procedure TTeeDataSet.InternalAddRecord(Buffer: Pointer; Append: Boolean);
begin
  Inc(FLastBookmark);
  if Append then InternalLast;
end;

function TTeeDataSet.GetBookmarkFlag(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}): TBookmarkFlag;
begin
  {$IFDEF CLR}
  with Marshal do
    Result := TBookmarkFlag(ReadByte(Buffer, FRecInfoOfs + 5)); // TRecInfo.BookmarkFlag
  {$ELSE}
  Result := PRecInfo(Buffer + RecInfoOfs).BookmarkFlag;
  {$ENDIF}
end;

procedure TTeeDataSet.SetBookmarkFlag(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF}; Value: TBookmarkFlag);
begin
  {$IFDEF CLR}
  with Marshal do
    WriteByte(Buffer, FRecInfoOfs + 5, Byte(Value)); // TRecInfo.BookmarkFlag
  {$ELSE}
  PRecInfo(Buffer + RecInfoOfs).BookmarkFlag := Value;
  {$ENDIF}
end;

{$IFDEF CLR}
procedure TTeeDataSet.GetBookmarkData(Buffer: TRecordBuffer; var Bookmark: TBookmark);
{$ELSE}
procedure TTeeDataSet.GetBookmarkData(Buffer: PChar; Data: Pointer);
{$ENDIF}
begin
  PInteger(Data)^ := PRecInfo(Buffer + RecInfoOfs).Bookmark;
end;

{$IFDEF CLR}
procedure TTeeDataSet.SetBookmarkData(Buffer: TRecordBuffer; const Bookmark: TBookmark);
{$ELSE}
procedure TTeeDataSet.SetBookmarkData(Buffer: PChar; Data: Pointer);
{$ENDIF}
begin
  PRecInfo(Buffer + RecInfoOfs).Bookmark := PInteger(Data)^;
end;

function TTeeDataSet.AllocRecordBuffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF};
begin
  IAllocated:=RecBufSize;
  GetMem(Result, IAllocated);
end;

procedure TTeeDataSet.FreeRecordBuffer(var Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF});
begin
  FreeMem(Buffer, IAllocated);
end;

procedure TTeeDataSet.InternalInitRecord(Buffer: {$IFDEF CLR}TRecordBuffer{$ELSE}PChar{$ENDIF});
begin
  ZeroMemory(Buffer, RecordSize);
end;

procedure TTeeDataSet.InternalFirst;
begin
  FCurRec := -1;
end;

function TTeeDataSet.GetRecNo: Integer;
begin
  UpdateCursorPos;

  if (FCurRec = -1) and (RecordCount > 0) then
     Result := 1
  else
     Result := FCurRec + 1;
end;

procedure TTeeDataSet.SetRecNo(Value: Integer);
begin
  if (Value >= 0) and (Value <= RecordCount) then
  begin
    FCurRec := Value - 1;
    Resync([]);
  end;
end;

procedure TTeeDataSet.InternalOpen;
var t : Integer;
begin
  { Fabricate integral bookmark values }
  FBookMarks:=TList.Create;

  for t:=1 to RecordCount do
      FBookMarks.Add({$IFDEF CLR}TObject{$ELSE}Pointer{$ENDIF}(t));

  FLastBookmark:=RecordCount;

  FCurRec:=-1;

  BookmarkSize := SizeOf(Integer);

  InternalInitFieldDefs;

  if DefaultFields then
     CreateFields;

  BindFields(True);
end;

procedure TTeeDataSet.InternalLast;
begin
  FCurRec:=RecordCount;
end;

function TTeeDataSet.IsCursorOpen: Boolean;
begin
  Result:=Assigned(FBookMarks);
end;

procedure TTeeDataSet.AddSeriesFields(Series:TChartSeries; PrefixSeriesName:Boolean=False);

  Function GetFieldName(Const ADefault,AName:String):String;
  begin
    if PrefixSeriesName then
    begin
      result:=Series.Name;

      if (result='') and Assigned(Series.ParentChart) then
         result:=TeeMsg_Series+TeeStr(1+Series.ParentChart.SeriesList.IndexOf(Series));

      result:=result+'.';
    end
    else
       result:='';

    if AName='' then result:=result+ADefault
                else result:=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
  {$IFDEF C3D4}
  With TFieldDef.Create(FieldDefs) do
  begin
    Name:=GetFieldName('','Color');
    DataType:=ftInteger;
    Size:=0;
    Required:=False;
    FieldNo:=1;
  end;
  {$ELSE}
  TFieldDef.Create(FieldDefs, GetFieldName('','Color'), ftInteger, 0, False, 1);
  {$ENDIF}

  With Series.XValues do AddField(DateTime,GetFieldName('X',Name));
  With Series.YValues do AddField(DateTime,GetFieldName('Y',Name));

  {$IFDEF C3D4}
  With TFieldDef.Create(FieldDefs) do
  begin
    Name:=GetFieldName('','Label');
    DataType:=ftString;
    Size:=MaxLabelLen;
    Required:=False;
    FieldNo:=4;
  end;
  {$ELSE}