fdef.pas

这是一个股票盘后数据分析系统基础底层,已经实现了基本的K线图的重现,RIS线,均线图的重现, 是在一个台湾高手发布的原码上修改的,现在支持通达信的股票数据格式.

unit fDef;

interface

uses
  Classes, Windows;

type

  { TArrayOfSingle }

  TArrayOfSingle = array of Single;
  TArrayOfInteger = array of Integer;

  { TStkDataRec }//0000,13100,13100X(nonEtron),13171X(nonBank),17100
  //股票数据
  PStkDataRec = ^TStkDataRec;
  TStkDataRec = packed record
    Date: Integer; //日期
    OP: Integer; //开盘价格
    HP: Integer; //最高价
    LP: Integer; //最低价
    CP: Integer; //收盘价
    amount: Integer; //成交额
    VOL: Integer; //成交量
    reservation: Integer; //保留位
  end;

  { IBaseDataFile }
  IBaseDataFile = interface(IUnknown)
    function getCount: Integer;
    function getFileName: string;
    function getHeader: Pointer;
    function getHeaderSize: Integer;
    function getRec(Index: Integer): Pointer;
    function getRecSize: Integer;
    procedure loadFromFile(const FileName: string);
    procedure saveAs(FileName: string);
    function seek(Index: Integer): Pointer;
  end;

  { TBaseDataFile }
  //
  TBaseDataFile = class(TInterfacedObject, IBaseDataFile)
  protected
    M: TMemoryStream;
    function getCount: Integer; virtual;
    function getFileName: string; virtual; abstract;
    function getHeader: Pointer; virtual;
    function getHeaderSize: Integer; virtual;
    function getRec(Index: Integer): Pointer; virtual;
    function getRecSize: Integer; virtual; abstract;
    procedure loadFromFile(const FileName: string); virtual;
    procedure saveAs(FileName: string); virtual;
    function seek(Index: Integer): Pointer; virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;
  end;

  { IDataFile }
   //function getData(Date: WORD): Pointer;->Date<MAX_DATADAY means Index from tail toward header, or Search data by Date
  IDataFile = interface(IBaseDataFile)
    //收盘价
    function getCP: TArrayOfSingle;
    function GetHigh: TArrayOfSingle;
    function GetLow: TArrayOfSingle;
    function getData(Date: DWORD): Pointer;
    function getStockName: string;
    function getUD: TArrayOfSingle;
    function getVOL: TArrayOfSingle;
    funcTion GetLastValue:Pointer;
    function indexOf(Date: DWORD): Integer; overload;
    function indexOf(Date: DWORD; L, H: Integer): Integer; overload;
    procedure save;
  end;

  { TDataFile }
  TDataFile = class(TBaseDataFile, IDataFile)
  protected
    FStockName: string;
    function FindData(Date: DWORD; L, H: Integer): Pointer; virtual;
    function getCP: TArrayOfSingle; //IDataFile
    function getHigh: TArrayOfSingle; //IDataFile
    function getLow: TArrayOfSingle; //IDataFile
    function getData(Date: DWORD): Pointer; virtual; //IDataFile
    function getFileName: string; override;
    function getRecSize: Integer; override;
    funcTion GetLastValue:Pointer;
    function getStockName: string; virtual; //IDataFile
    function getUD: TArrayOfSingle; //IDataFile
    function getVOL: TArrayOfSingle; //IDataFile
    function indexOf(Date: DWORD): Integer; overload; //IDataFile
    function indexOf(Date: DWORD; L, H: Integer): Integer; overload; //IDataFile
    function RecStart: Integer; virtual;
    procedure save; virtual; //IDataFile
    function seek(Index: Integer): Pointer; override;
  public
    constructor Create(const StockName: string); reintroduce;
  end;

implementation

uses fUtils, SysUtils, UCommon;

{ TBaseDataFile }

{
******************************** TBaseDataFile *********************************
}

constructor TBaseDataFile.Create;
begin
  inherited;
  //装载数据
  loadFromFile(getFileName);
end;

destructor TBaseDataFile.Destroy;
begin
  _free_(M);
  inherited;
end;

function TBaseDataFile.getCount: Integer;
begin
  //交易数据笔数
  if M = nil then
    Result := 0
  else
    Result := (M.Size - getHeaderSize) div getRecSize;
end;

function TBaseDataFile.getHeader: Pointer;
begin
  if M <> nil then
    Result := M.Memory
  else
    Result := nil;
end;

function TBaseDataFile.getHeaderSize: Integer;
begin
  Result := 0;
end;

function TBaseDataFile.getRec(Index: Integer): Pointer;
begin
  //某一笔记录的地址
  if (Index > -1) and (Index < getCount) then
    Result := seek(Index)
  else
    Result := nil;
end;

procedure TBaseDataFile.loadFromFile(const FileName: string);
begin
  _free_(M);
  if FileExists(FileName) then
  begin
    M := TMemoryStream.Create;
    M.loadFromFile(FileName);
    M.Position := 0;
  end;
end;

procedure TBaseDataFile.saveAs(FileName: string);
begin
  if M <> nil then
    M.SaveToFile(FileName);
end;

function TBaseDataFile.seek(Index: Integer): Pointer;
begin
  //定位某一笔数据上
  if M = nil then
    Result := nil
  else
    Result := Pointer(Integer(getHeader) + getHeaderSize + Index * getRecSize);
end;

{ TDataFile }

{
********************************** TDataFile ***********************************
}

constructor TDataFile.Create(const StockName: string);
begin
  //股票名
  FStockName := Trim(StockName);
  inherited Create;
end;

function TDataFile.FindData(Date: DWORD; L, H: Integer): Pointer;
var
  M       : Integer;
  D       : DWORD;
begin
  Result := nil;
  if L <= H then
  begin
    //中值 (L+H) div 2
    M := (L + H) shr 1;
    D := PWORD(getRec(M))^;

    //按中值查找
    if Date = D then
      Result := getRec(M)
    else
      if Date < D then
        Result := FindData(Date, L, M - 1)
      else
        Result := FindData(Date, M + 1, H);
  end;
end;

function TDataFile.getCP: TArrayOfSingle;
var
  I       : Integer;
begin
  SetLength(Result, getCount);
  for I := 0 to getCount - 1 do
    Result[I] := PStkDataRec(getRec(I)).CP / 100.0;
end;

function TDataFile.getData(Date: DWORD): Pointer;
begin
  if Date > 20000 then
    Result := FindData(Date, 0, getCount - 1) //Search by Date
  else
    Result := getRec(getCount - Date - 1); //Index Record from tail toward header
end;

funcTion TDataFile.GetLastValue:Pointer;
begin
  Result := getRec(getCount -1); //Index Record from tail toward header
end;

function TDataFile.getFileName: string;
begin
  //返回数据文件名
  Result := FStockName;
end;

function TDataFile.getRecSize: Integer;
begin
  Result := SizeOf(TStkDataRec);
end;

function TDataFile.getStockName: string;
begin
  Result := FStockName;
end;

function TDataFile.getUD: TArrayOfSingle;
var
  I       : Integer;
begin
  SetLength(Result, getCount);
  for I := 0 to getCount - 1 do
  begin
    if I = 0 then
      Result[I] := 0
    else
      Result[I] := (PStkDataRec(getRec(I)).CP - PStkDataRec(getRec(I - 1)).CP) / 100.0;
  end;
end;

function TDataFile.GetHigh: TArrayOfSingle;
var
  I       : Integer;
begin
  SetLength(Result, getCount);
  for I := 0 to getCount - 1 do
  begin
    if I = 0 then
      Result[I] := 0
    else
      Result[I] := (PStkDataRec(getRec(I)).HP / 100.0);
  end;
end;

function TDataFile.GetLow: TArrayOfSingle;
var
  I       : Integer;
begin
  SetLength(Result, getCount);
  for I := 0 to getCount - 1 do
  begin
    if I = 0 then
      Result[I] := 0
    else
      Result[I] := (PStkDataRec(getRec(I)).LP / 100.0);
  end;
end;

function TDataFile.getVOL: TArrayOfSingle;
var
  I       : Integer;
begin
  SetLength(Result, getCount);
  for I := 0 to getCount - 1 do
    Result[I] := PStkDataRec(getRec(I)).VOL / 100.0;
end;

function TDataFile.indexOf(Date: DWORD): Integer;
begin
  Result := indexOf(Date, 0, getCount - 1);
end;

function TDataFile.indexOf(Date: DWORD; L, H: Integer): Integer;
var
  M       : Integer;
  D       : DWORD;
begin
  Result := -1;
  if L <= H then
  begin
    //取中值
    M := (L + H) shr 1;
    D := PWORD(getRec(M))^;

    //按中值查找
    if Date = D then
      Result := M
    else
      if Date < D then
        Result := indexOf(Date, L, M - 1)
      else
        Result := indexOf(Date, M + 1, H);
  end;
end;

function TDataFile.RecStart: Integer;
begin
  Result := 0;
end;

procedure TDataFile.save;
begin
  if M <> nil then
    M.SaveToFile(getFileName);
end;

function TDataFile.seek(Index: Integer): Pointer;
begin
  if (M = nil) or (getCount = 0) then
    Result := nil
  else
  begin
    Index := (Index + RecStart) mod getCount;
    Result := Pointer(Integer(M.Memory) + getHeaderSize + Index * getRecSize);
  end;
end;

end.