stockun.pas

delphi 作 的k线图

{**********************************************************************}
{*程序描述：     如何用Delphi读钱龙数据画股票k线图范例                *}
{*  程序            :    战晓冬                                       *}
{* 编译器                :   Borland Delphi Enterprise 6.0            *}
{* Copyright(C)          :   战晓冬                        2000       *}
{* 上士软件工作室        :  WWW.LuckGuest.com    [e-mail]  *}
{**********************************************************************}
unit StockUn;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ToolWin, Menus, ExtCtrls, TeeProcs, TeEngine, Chart, mxgraph,
  Series, StdCtrls, ArrowCha, Buttons;
type
  TStockRec = packed record   {定义一个记录，保存股票信息。}
    Date: Longint;  {时间}
    Open:longint;   {开盘}
    High:longint;   {最高价}
    Low:longint;    {最低价}
    Close:longint;  {收盘}
    Amount:longint; {成交额}
    Volume:longint; {成交量}
    Topiece:longint;
    X1:longint;
    X2:longint;
  end;

  TRecordStream = class(TFileStream)  
  private
    function GetNumRecs: Longint;
    function GetCurRec: Longint;
    procedure SetCurRec(RecNo: Longint);
  protected
    function GetRecSize: Longint; virtual;
  public
    function SeekRec(RecNo: Longint; Origin: Word): Longint;
    function WriteRec(const Rec): Longint;
    function AppendRec(const Rec): Longint;
    function ReadRec(var Rec): Longint;
    procedure First;
    procedure Last;
    procedure NextRec;
    procedure PreviousRec;
    property NumRecs: Longint read GetNumRecs;
    property CurRec: Longint read GetCurRec write SetCurRec;
  end;

  TStockForm = class(TForm)
    StatusBar1: TStatusBar;
    Chart1: TChart;
    Series1: TLineSeries;
    Series2: TFastLineSeries;
    Series3: TFastLineSeries;
    Series4: TFastLineSeries;
    SpeedButton1: TSpeedButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Chart1MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure Series1AfterDrawValues(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure Chart1AfterDraw(Sender: TObject);

  private
    { Private declarations }
  public
    { Public declarations }
    OldX,OldY:Longint;
    CrossHairColor:TColor;
    CrossHairStyle:TPenStyle;
    stockRec: TstockRec;
    RecordStream: TRecordStream;
    DayFile:File of TStockRec;
    Fname:String;
    procedure ChartADDData;
    procedure DrawCross(AX,AY:Integer);
  end;

  
var
  StockForm: TStockForm;

implementation

function TRecordStream.GetRecSize:Longint;  {返回记录长度}
begin
  Result := SizeOf(TStockRec);
end;

function TRecordStream.GetNumRecs: Longint;  {返回记录个数}
begin
  Result := Size div GetRecSize;
end;

{返回当前记录位置，文件指针通常在记录的开始，而非Position div GetRecSize处。}
function TRecordStream.GetCurRec: Longint;
begin 
  Result := (Position div GetRecSize) + 1;
end;                                                           

procedure TRecordStream.SetCurRec(RecNo: Longint);  {通过RecNo将记录定位}
begin
  if RecNo > 0 then
    Position := (RecNo - 1) * GetRecSize
  else
    Raise Exception.Create('Cannot go beyond beginning of file.');
end;

 {通过RecNo将文件指针定位}
function TRecordStream.SeekRec(RecNo: Longint; Origin: Word): Longint;
begin
  Result := Seek(RecNo * GetRecSize, Origin);
end;

function TRecordStream.WriteRec(Const Rec): Longint; {将记录Rec写入流中}
begin
  Result := Write(Rec, GetRecSize);
end;

function TRecordStream.AppendRec(Const Rec): Longint; {将记录Rec写入流中}
begin
  Seek(0, 2);
  Result := Write(Rec, GetRecSize);
end;

function TRecordStream.ReadRec(var Rec): Longint; {从流中读取记录并将指针返回记录开始}
begin
  Result := Read(Rec, GetRecSize);
  Seek(-GetRecSize, 1);
end;

procedure TRecordStream.First;  {将指针返回流的开始}
begin
  Seek(0, 0);
end;

procedure TRecordStream.Last;  {将指针返回流的末尾}
begin
  Seek(0, 2);
  Seek(-GetRecSize, 1);
end;

procedure TRecordStream.NextRec; {只要未到文件末尾，就将文件指针定在下一记录处}
begin
  if ((Position + GetRecSize) div GetRecSize) = GetNumRecs then
    raise Exception.Create('Cannot read beyond end of file')
  else
    Seek(GetRecSize, 1);
end;

procedure TRecordStream.PreviousRec;{只要未到文件开始，就将文件指针定在前一记录处}
begin
  if (Position - GetRecSize >= 0) then
    Seek(-GetRecSize, 1)
  else
    Raise Exception.Create('Cannot read beyond beginning of the  file.');
end;


{$R *.DFM}

procedure TStockForm.Chart1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
var
  tmpX,tmpY:Double;
begin
  if (OldX<>-1) then
    begin
      DrawCross(OldX,OldY);   {画小十字鼠标}
      OldX:=-1;
    end;
  {检查鼠标是否在图表区}
  if PtInRect( Chart1.ChartRect, Point(X-Chart1.Width3D,Y+Chart1.Height3D)) then
    begin
      DrawCross(x,y);   {在当前位置画十字准线}
      OldX:=x;   {保存旧位置}
      OldY:=y;
      With Series1 do   {设置标签文本}
        begin
          GetCursorValues(tmpX,tmpY);  {获取鼠标位置数据}
          Label1.Caption:=GetVertAxis.LabelValue(tmpY)+'  '+
            GetHorizAxis.LabelValue(tmpX);
        end;
    end;
end;


procedure TStockForm.FormCreate(Sender: TObject);
begin
  OldX:=-1;                 {初始化变量}
  CrossHairColor:=clRed;    {颜色}
  CrossHairStyle:=psSolid;  {线形}
  Fname:='600734.Day';     
  if  FileExists(FName) then
    RecordStream := TRecordStream.Create(FName, fmOpenReadWrite)
  else
    RecordStream := TRecordStream.Create(FName, fmCreate);
end;

procedure TStockForm.FormDestroy(Sender: TObject);
begin
  RecordStream.Free;
end;

procedure TStockForm.FormActivate(Sender: TObject);
begin
  RecordStream.Last;
  ChartADDData;
  while (((RecordStream.Position + 40) div 40) > RecordStream.NumRecs-9) do
    begin
      RecordStream.PreviousRec;
      ChartADDData;
    end;
end;

procedure TStockForm.ChartADDData;
var
  FormatDayLineDateYear,FormatDayLineDateMonth,
  FormatDayLineDateDay,FormatDayLineDate,DayLineDate:string;
begin
  RecordStream.ReadRec(stockRec);
  DayLineDate:=IntToStr(StockRec.Date);{将日期数转化成字符串}
  FormatDayLineDateYear:=Copy(DayLineDate,2,2);{分离出年}
  FormatDayLineDateMonth:=Copy(DayLineDate,5,2);{分离处月}
  FormatDayLineDateDay:=Copy(DayLineDate,7,2);  {分离出日}
  FormatDayLineDate:=Concat(FormatDayLineDateYear,'-',FormatDayLineDateMonth,'-',FormatDayLineDateDay);

  Series1.Add((stockRec.open / 1000),FormatDayLineDate,clBlack);
  Series2.Add((stockRec.close / 1000),FormatDayLineDate,clTeeColor);
  Series3.Add((stockRec.Low / 1000),FormatDayLineDate,clTeeColor);
  Series4.Add((stockRec.High / 1000),FormatDayLineDate,clTeeColor);
end;

procedure TStockForm.DrawCross(AX,AY:Integer); {画十字线鼠标}
begin
  With Chart1,Canvas do
    begin
      Pen.Color:=CrossHairColor;        {画笔颜色}
      Pen.Style:=CrossHairStyle;        {画笔类型}
      Pen.Mode:=pmXor;                  {如何画线}
      Pen.Width:=1;                     {画笔宽度}
      MoveTo(ax,ChartRect.Top-Height3D);
      LineTo(ax,ChartRect.Bottom-Height3D);
      MoveTo(ChartRect.Left+Width3D,ay);
      LineTo(ChartRect.Right+Width3D,ay);
    end;
end;

procedure TStockForm.Series1AfterDrawValues(Sender: TObject);
begin
  OldX:=-1;  {重置鼠标原来位置}
end;

procedure TStockForm.SpeedButton1Click(Sender: TObject);
begin
  Series1.Clear;
  RecordStream.First;
  ChartADDData; 
  while ((RecordStream.Position + 40) div 40) < RecordStream.NumRecs do
    begin
      RecordStream.NextRec;
      ChartADDData;
    end;
    RecordStream.last;
    ChartADDData;
end;

procedure TStockForm.Chart1AfterDraw(Sender: TObject);  {画阴阳线}
var
  XValueNO:integer; {X轴点}
begin
  With Chart1,Canvas do
    begin
      for  XValueNO:=0 to Series1.LastValueIndex  do
        begin
          begin
            if (Series1.CalcyPos(XValueNO) < Series2.CalcyPos(XValueNO)) then
              begin
                Brush.Color:=clWhite;
                Pen.Color:=clWhite;        {画笔颜色}
              end
              else
                begin
                  Brush.Color:=clRed;
                  Pen.Color:=clRed;
                end;
          end;
          Pen.Style:=pssolid;        {画笔类型}
          Pen.Width:=1;
            begin
              MoveTo(Series3.CalcXPos(XValueNO) ,Series3.CalcyPos(XValueNO));
              LineTo(Series4.CalcXPos(XValueNO) ,Series4.CalcyPos(XValueNO));
              Rectangle(Series1.CalcXPos(XValueNO)-5,Series1.CalcyPos(xValueNO),
                Series1.CalcXPos(XValueNO)+5,Series2.CalcyPos(xValueNO));
            end;
        end;
    end;
end;

end.